Excel VBA，剪切粘贴添加和编辑文本

Question

我具有如图一所示的Excel数据。

我尝试查找文本Statetext01并使用正确的索引（从1-24）对其进行24个拷贝，并且还将A列中的文本从State_text_1为State_text_24 。

之后，我需要在Excel工作表中找到下一个并执行相同的操作。 Excel工作表中的行超过20000。

那可能吗？

Answer 1

这样的事情对我有用，并且假设您的数据在“ Sheet1”上，它也应该对您有用：

Option Explicit


Sub copyMultiple()
 Dim sht As Worksheet
 Dim idx As Integer, lastRow As Integer, r As Integer, r2 As Integer
 Dim val As String
 Set sht = Worksheets("Sheet1")

 With sht
   lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

   For r = lastRow To 1 Step -1
     val = .Cells(r, "D").Value
     idx = InStr(1, val, "Statetext01", vbTextCompare)
     If idx <> 0 Then
       Rows(r + 1).Resize(23).Insert shift:=xlShiftDown
       .Rows(r).Copy Destination:=.Rows(r + 1 & ":" & r + 23)
       For r2 = 1 To 24
         With .Cells(r + r2 - 1, "D")
           .Value = Replace(.Value, "Statetext01", "Statetext" & Right("00" & r2, 2))
         End With
         With .Cells(r + r2 - 1, "A")
          .Value = Left(.Value, InStrRev(.Value, "_")) & "State_text_" & r2
         End With
       Next
     End If
   Next
 End With

End Sub