剪切并粘贴特殊字体数据，将粘贴的数据对齐到 Excel 中不同列中的其他数据

Question

正在寻找可以将复制的数据与 A 列中存在的数据对齐的宏

我的原始数据为： Raw Data

然后我有一个宏，可以将 Italics 中的所有数据从 B 列复制到 C

    Sub copy_Italic()
    'Narrations in Italics Copy
    Dim LastRow  As Long, x As Long, y As Long, txt1 As String, txt As String
    LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To LastRow
        txt1 = ""
        txt = Cells(x, 2)
        If txt <> "" Then
            For y = Len(txt) To 1 Step -1
                If Cells(x, 2).Characters(Start:=y, Length:=1).Font.Italic Then
                    txt1 = Cells(x, 2).Characters(Start:=y, Length:=1).Text & txt1
                End If
            Next y
            Cells(x, 3) = txt1
        End If
        End Sub

所以我需要一个宏来选择 C 列中的旁白数据，然后将它们与 A 列中可用的数据对齐，还选择 "entered by..." 文本并将其粘贴到 D 列，同时对齐 A 列，然后删除不需要的行查看结果： Desired Results

谢谢。也欢迎对上述宏进行改进！！

Answer 1

请使用下面的代码。 if 将循环遍历您的数据并将所有 italic values 添加到相应行中的列 C。然后它将过滤 "entered by" 单词并将该值添加到列 D （也在相应的行中）。之后，它将删除列 B 中所有以斜体书写的行。

Sub copy_Italic()
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To LastRow
    If Range("A" & x) <> 0 Then
        Row = x
        txt = Cells(x, 2)
        If txt <> "" Then
            For y = Len(txt) To 1 Step -1
                If Cells(x, 2).Characters(Start:=y, Length:=1).Font.Italic Then
                    txt1 = Cells(x, 2).Characters(Start:=y, Length:=1).Text & txt1
                End If
            Next y
                If InStr(LCase(txt1), "entered by") = 1 Then
                Cells(Row, 4) = txt1
                Else
                Debug.Print txtl
                    For Z = 1 To 10
                    If Range("c" & Row + Z - 1).Value = "" Then

                          Cells(Row + Z - 1, 3) = txt1
                          GoTo Tu:
                    End If
                    Next Z
                End If
Tu:
    End If
Else
        txt1 = ""
        txt = Cells(x, 2)
        If txt <> "" Then
            For y = Len(txt) To 1 Step -1
                If Cells(x, 2).Characters(Start:=y, Length:=1).Font.Italic Then
                    txt1 = Cells(x, 2).Characters(Start:=y, Length:=1).Text & txt1
                End If
            Next y
                If InStr(LCase(txt1), "entered by") = 1 Then
                Cells(Row, 4) = txt1
                Else
                Debug.Print txtl
                    For Z = 1 To 10
                    If Range("c" & Row + Z - 1).Value = "" Then

                          Cells(Row + Z - 1, 3) = txt1
                          GoTo ovdje:
                    End If
                    Next Z
                End If
ovdje:
        End If
    End If
Next x

For i = LastRow To 1 Step -1
        If Range("b" & i).Font.Italic = True Then
            Range("B" & i).EntireRow.Delete
        End If
Next i
End Sub

剪切并粘贴特殊字体数据，将粘贴的数据对齐到 Excel 中不同列中的其他数据

Cut and Paste Special font data, align the data pasted to other data in a different column in Excel

excel

vba

paste