VBA: Suchen, Speichern und ersetzen durch Reihen entsprechend den Bedingungen

Question

Ich habe eine Eingabe wie folgt aus:

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 

Ich habe einen Code wie folgt:

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 

Was ich zu tun versuchen: Finden Sie alle Zeilen beginnend mit "kap" und speichern Sie 6 Zeichen/int nach dem ersten "KP" als i und 6 Zeichen/int nach dem zweiten "KP" als k. Suchen Sie dann den gesamten Datensatz (Hunderte von Zeilen in Spalte A), wenn sie den String i enthalten, und falls ja, ersetzen Sie ihn dann durch den String k. Und dies zu wiederholen. So wird es mit einer anderen Zeile, die mit "kap" beginnt, dasselbe tun. Der Code gibt mir eine Fehlermeldung: Subscript außerhalb des Bereichs, wenn es zum zweiten Mal zu "Spalten (" A ") ..." kommt. Kannst du mir bitte helfen?

DANKE IM VORAUS

Answer 1

bearbeitet alle gesuchte Zeichenkette, die die gleichen Vorkommnisse zu machen („kap, *“)

Sie (über Replace()) den Bereich Sie sind nicht ändern wollen durch Looping

so alle benötigten Ersetzungen in einem Array sammeln, während er durch den Bereich Looping und dann eine Schleife durch das Array und die Ersetzungen machen

mögen folgt:

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