VBA：搜索，保存和行會替換根據情況

Question

我有一個這樣的輸入：

gen,N,,,GONGD,,,N,,,KL,0007bd,,,,,,,,TAK, 
gen,N,,,RATEC,,,N,,,KP,0007bc,,,,,,,,TAZ, 
kap,N,,,EBFWE,N,,,,,,,,,KP,002bd4,,,KP,123000,,,,,N,,,,P 
kap,N,,,ST,WEIT,E3,EBFWEI,,,KP,002bd2,N,,,,,,KP,002bd3,,,,,,,Z,MG00,,,,,N,,,,P 

我有這樣的代碼：

Sub Find() 
Dim rFoundAddress As Range 
Dim sFirstAddress As String 
Dim x As Long 

With ThisWorkbook.Worksheets("Sheet1").Columns(1) 
    Set rFoundAddress = .Find("kap,*", LookIn:=xlValues, LookAt:=xlWhole) 
    If Not rFoundAddress Is Nothing Then 
     sFirstAddress = rFoundAddress.Address 
     Do 
      Dim WrdArray() As String 
      Dim text_string As String 
      Dim i As String 
      Dim k As String 
      Dim num As Long 
      text_string = rFoundAddress 
      WrdArray() = Split(text_string, "KP,") 
      i = Left(WrdArray(1), 6) 
      k = Left(WrdArray(2), 6) 

      Columns("A").Replace What:=i, _ 
         Replacement:=k, _ 
         LookAt:=xlPart, _ 
         SearchOrder:=xlByRows, _ 
         MatchCase:=False, _ 
         SearchFormat:=False, _ 
         ReplaceFormat:=False 

      Set rFoundAddress = .FindNext(rFoundAddress) 
     Loop While Not rFoundAddress Is Nothing And _ 
      rFoundAddress.Address <> sFirstAddress 
    End If 
End With 
End Sub 

我所試圖做的事： 找到所有以「kap」開頭的行，並在第一個「KP」後保存6個字符/ int，在第二個「KP」後保存爲6個chars/int。然後搜索整個數據集（列A中的數百行），如果它們包含字符串i，並且如果是，則將其替換爲字符串k。並循環這一點。所以它會用另一條以「kap」開頭的行來做同樣的事情。代碼給我錯誤消息：第二次涉及到「列（」A「）...」時，下標超出範圍。你能幫我嗎？

預先感謝您

Answer 1

編輯讓所有查找的字符串出現相同的（「KAP，*」）

你不想修改（通過Replace()）你的範圍通過

循環以便收集所有需要替換成陣列而通過陣列通過範圍循環，然後循環，使替換

喜歡如下：

Option Explicit 

Sub Find() 
    Dim rFound As Range 
    Dim sFirstAddress As String 
    Dim val As Variant 
    Dim nKap As Long 

    With ThisWorkbook.Worksheets("Sheet1").Columns(1) 
     nKap = Application.WorksheetFunction.CountIf(.Cells, "kap,*") '<--| count the occurrences of "kap,*" 
     If nKap > 0 Then 
      ReDim vals(1 To nKap) As Variant '<--| array that will collect all find/replace couples 
      nKap = 0 
      Set rFound = .Find("kap,*", LookIn:=xlValues, LookAt:=xlWhole) 
      sFirstAddress = rFound.Address 
      Do 
       nKap = nKap + 1 
       vals(nKap) = Split(Split(Split(rFound.text, "KP")(1), ",")(1) & "," & Split(Split(rFound.text, "KP")(2), ",")(1), ",") '<--| store the ith couple of find/replace values 
       Set rFound = .FindNext(rFound) 
      Loop While rFound.Address <> sFirstAddress 

      For Each val In vals '<--| loop through values to be replaced array 
       .Replace What:=val(0), _ 
         Replacement:=val(1), _ 
         LookAt:=xlPart, _ 
         SearchOrder:=xlByRows, _ 
         MatchCase:=False, _ 
         SearchFormat:=False, _ 
         ReplaceFormat:=False 
      Next val 
     End If 


    End With 
End Sub 

Function GetValues(txt As String) As Variant 
    If InStr(txt, "KP") > 0 Then GetValues = Split(Split(Split(txt, "KP")(1), ",")(1) & "," & Split(Split(txt, "KP")(2), ",")(1), ",") 
End Function