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

Question

I have the Excel data as seen in picture one.

I try to find the text Statetext01 and make 24 copies of it with the right index from 1-24 and I will also change the text in column A from State_text_1 to State_text_24 .

After that, I need to find the next one in the Excel sheet and do the same. The Excel sheet is in over 20000 rows.

Is that possible?

Answer 1

Something like this works for me and should work for you assuming your data is on '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