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» и сохраните 6 символов/int после первого «KP» как i и 6 символов/int после второго «KP» как k. Затем выполните поиск всего набора данных (сотни строк в столбце A), если они содержат строку i, и если да, то замените ее на строку k. И зацикливать это. Поэтому он будет делать то же самое с другой строкой, начинающейся с «kap». Код дает мне сообщение об ошибке: Подзаголовок вне диапазона, когда дело доходит до «Столбцы (« A ») ...» во второй раз. Не могли бы вы мне помочь?

СПАСИБО ЗАРАНЕЕ

Answer 1

отредактировал сделать все обыскали строки вхождений же («кап, *»)

вы не хотите изменять (с помощью 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