Question

寻找可以将数据复制到A列中存在的数据的宏

我的原始数据如下： Raw Data

然后我有一个宏将斜体中的所有数据从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列中可用的数据对齐，并选择由...输入的＆＃34;将文本粘贴到列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中不同列中的其他数据对齐

1 个答案: