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

Question

我有Excel数据，如图一所示。

我尝试找到文本Statetext01并使用1-24中的正确索引制作24份文本副本，我还会将A列中的文字从State_text_1更改为State_text_24

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

这可能吗？

Answer 1

这样的事情对我有用，如果您的数据已经开启，应该对您有用＃Sheet;＆＃39;：

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