excel - 更改特定文本后查找文本，插入行然后复制和粘贴

Question

我有行和列的数据，我希望我的宏在一列中找到某些文本（位置），并在找到位置后创建 2 行或更多行并复制找到的位置行的数据，但将位置更改为增量1。例如，如果它在伦敦位置列中找到一个值，则将整行复制到 2 个新插入的行，但将伦敦文本更改为 London1 和 London 2，依此类推。请帮忙。

代码

sub Insert_CopyPaste()

    Dim LastRow As Long 
    With Sheets("Sheet2") 
        .Activate 
        LastRow = .Range("C6000").End(xlUp).Row 
        For i = 2 To LastRow 
            If (InStr(1, .Range("c" & i).Value, "03M-EX", vbTextCompare) > 0) Then 
                .Range("a" & i).EntireRow.Copy 
                .Range("a" & i + 1).EntireRow.Insert 
                .Range("a" & i + 1).PasteSpecial xlPasteValues 
            End If 
        Next
    End With 
    Exit Sub 

End Sub

Answer 1

我确定这就是你所追求的。如果不清楚，我可以解释。

sub Insert_CopyPaste()

    Dim LastRow As Long, i as long, txt as string
    txt = "03M-EX" 'set text to search
    With Sheets("Sheet2") 

        LastRow = .Range("C6000").End(xlUp).Row  
        while i <= lastrow 

            If .Range("c" & i).Value = txt Then 

                .Range("a" & i).EntireRow.Copy 
                .Range("a" & i + 1).EntireRow.Insert 
                .Range("a" & i + 1).PasteSpecial xlPasteValues 
                .Range("c" & i + 1).value = txt & "1" 'add 1 to text

                i = i + 1 'skip newly added row
                lastrow = lastrow + 2 'increase last row reference by 2

                .Range("a" & i).EntireRow.Copy 
                .Range("a" & i + 1).EntireRow.Insert 
                .Range("a" & i + 1).PasteSpecial xlPasteValuesxlPasteValues 
                .Range("c" & i + 1).value = txt & "2"

            End If 

            i = i + 1 'goto next row to check 

        loop
    End With  
End Sub