VBA Zeichensätze ersetzen

[Dreas-wing]

Hallo beisammen,

ich brauche die Hilfe eines VBA Experten. Ich möchte per VBA Artikelnummer von falschen Daten bereinigen. Der Input könnte wie folgt ausschauen

1234657 789B123 - 02
34567.89 / 1234675
98765G1 G99 1234569-01
G789 1234567, 9876123
etc.

Per Trim, Replace bekomme ich Störzeichen wie ",", ".", "/" weg. Aber wie bekomme ich variable Zeichenfolgen wie "G789" & "G99" oder "X***" mit " " ersetzt? Im Grunde müsste alles was weniger 7 Zeichen hat raus, jedoch können auch mehrere 7 stellige Zeichenfolgen, getrennt durch ein Leerzeichen in der Zelle stehen. .
Ergebnis hier müsste sein:

1234657 789B123
3456789 1234675
98765G1 1234569
1234567 9876123


Hätte jemand eine Idee?

Mein Code soweit:

Private Sub replace1()


For i = 0 To ThisWorkbook.Worksheets("Replace").Cells(Worksheets("Replace").Rows.Count, 2).End(xlUp).Row



ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2) = replace(ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2), "-00", " ")

ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2) = replace(ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2), "-01", " ")

ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2) = replace(ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2), "-02", " ")

ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2) = replace(ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2), "-03", " ")

ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2) = replace(ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2), "-", " ")

ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2) = replace(ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2), "/", " ")

ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2) = replace(ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2), ",", " ")

ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2) = WorksheetFunction.trim(ThisWorkbook.Worksheets("Replace").Cells(2 + i, 2))



Next i


End Sub


Besten Dank
Andreas

[Warkings]

... Hätte jemand eine Idee? ...

Falls Dein Ergebnis nur noch Zeichenfolgen enthält, die Durch ein Leerzeichen getrennt sind, folgende Ideen
Idee 1: Mit Split die Zeichenfolgen in ein Array schieben, die leere Elemente in dem sich ergebenden Array rausfiltern und danach per Join das Array wieder zu einer Zeichenfolge zusammenbauen
Idee2: Mit Hilfe von regex nur die Zeichenfolgen suchen, die mehr als 7 Zeichen haben, Regex Suchmuster z.B. für 7 bis 10 stellige Zeichenfolge wäre \w{7,10}

Mit regex könntest Du sicher auch die Zeichenfolge bereinigen, z.B. mit dieser Funktion

[schauan]

Hallöchen,

vielleicht geht das schneller mit regex, aber Du könntest auch so vorgehen:

- Daten des Bereichs in ein Array1 übernehmen
- Array1 "zeilenweise" durchgehen
-> Zeichenkette in ein Array2 wandeln, Trennzeichen = Leerzeichen
-> Elemente des Array2 mit 7 Stellen in eine temporäre Zeichenkette schreiben
-> am Ende Zeichenkette in die "Zeile" des Array1 schreiben
- nächste Zeile von Array1
- Array1 am Ende in Bereich zurückschreiben

[Elex]

Hi

Wenn du es nur aus den Ideen schaffst um so besser. 

Sonst hier mal der Code der die Beispiele abdeckt. Mach dir eine Kopie vorher. Es wird direkt das Original ersetzt.

Code:

Public Sub Ersetzen()
Dim Werte, k As Long, kk, arrW, strA As String

With Range("A1:A4")
    .Replace What:="-", Replacement:=" "
    .Replace What:=",", Replacement:=""
    .Replace What:=".", Replacement:=""
    .Replace What:="/", Replacement:=""
     Werte = .Value
   
    For k = 1 To UBound(Werte)
      arrW = Split(Werte(k, 1), " ")
      strA = ""
        For Each kk In arrW
          If Len(kk) = 7 Then strA = strA & " " & kk
        Next kk
      Werte(k, 1) = Mid(strA, 2)
    Next k
    .Value = Werte
End With

End Sub

Gruß Elex

[Case]

Hallo,  

bezogen auf deine Beispieldaten hier mit REGEXP:

  REGEXP_7_stellige_Zeichenfolge_mehrere_auslesen_CEF.xlsb (Größe: 14,72 KB / Downloads: 4)

[snb]

Ein UDF:

Code:

Function F_snb(c00)
  sn = Split(Replace(Replace(Replace(Replace(c00, "/", " "), ".", ""), "-", " "), ",", " "))

  For j = 0 To UBound(sn)
    If Len(sn(j)) <> 7 Then sn(j) = ""
  Next

  F_snb = Application.Trim(Join(sn))
End Function

NB. Du bewertest ein Punkt anders als ein  /, , oder -

[Dreas-wing]

Hallo,

Geil, das hat auf Anhieb geklappt.
Besten Dank für deine Mühen.

---

Hallo beisammen,

ich Danke euch für eure Mühen. Es hat mit dem Code von Elex geklappt.

Beste Grüße