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