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