| Tabelle1 | ||||||||||
| ||||||||||
| Tabelle1 | ||||||||||||||||||||||
| ||||||||||||||||||||||
| Tabelle1 | ||||||||||||||||||||
| ||||||||||||||||||||
Sub Extrahieren()
Dim lLetzte As Long ' letzte verwendete Zeile in Spalte A
Dim lZeile As Long ' For/Next Lauf-Index
Dim iPos As Integer ' Position der Klammer auf
Dim iWoPos As Integer ' For/Next Lauf-Index
Dim sWoZei As String * 1 ' Zeichen im zu separierenden Wort
lLetzte = IIf(Range("A65536") <> "", 65536, Range("A65536").End(xlUp).Row)
For lZeile = 2 To lLetzte ' ab Zeile 2 bis Ende Daten
iPos = InStr(Range("A" & lZeile).Value, "(") ' Position Klammer auf suchen
If iPos > 0 Then ' Klammer auf vorhanden ?
Range("B" & lZeile).ClearContents ' Ergebnis-Zelle leeren
' Position Klammer auf hochrechnen bis kein Leerzeichen mehr folgt
' so können dem Klammer auf kein, bis beliebig viele Leerzeichen folgen
Do
iPos = iPos + 1
Loop Until Mid(Range("A" & lZeile).Value, iPos, 1) <> " "
' die Zeichen ab Position Kunden-Nr einzeln übernehmen und an die neue
' Zelle übergeben, bis Klammer zu gefunden wird.
For iWoPos = iPos To Len(Range("A" & lZeile).Value)
sWoZei = Mid(Range("A" & lZeile).Value, iWoPos, 1)
If sWoZei <> ")" Then ' auf Klammer zu verproben
Range("B" & lZeile).Value = Range("B" & lZeile).Value & sWoZei
Else
Exit For ' Leerzeichen gefunden => For/Next verlassen
End If
Next iWoPos ' nächste Wort-Position
End If
Next lZeile ' nächste Zeile bearbeiten
End Sub
Sub Test()
SplitMe Range("A1:A10"), "\((\d{3,})\)"
End Sub
Sub Extrahieren()
Dim lLetzte As Long ' letzte verwendete Zeile in Spalte A
Dim lZeile As Long ' For/Next Lauf-Index
Dim iPos As Integer ' Position der Klammer auf
Dim iPosS As Integer ' Position der Klammer auf Speicher
Dim iWoPos As Integer ' For/Next Lauf-Index
Dim sWoZei As String * 1 ' Zeichen im zu separierenden Wort
lLetzte = IIf(Range("A65536") <> "", 65536, Range("A65536").End(xlUp).Row)
For lZeile = 2 To lLetzte ' ab Zeile 2 bis Ende Daten
iPos = InStr(1, Range("A" & lZeile).Value, "(") ' Position Klammer auf suchen
If iPos > 0 Then ' Klammer auf vorhanden ?
iPosS = iPos + 1
iPos = InStr(iPosS, Range("A" & lZeile).Value, "(") ' Position Klammer auf suchen
If iPos = 0 Then iPos = iPosS
Range("B" & lZeile).ClearContents ' Ergebnis-Zelle leeren
' Position Klammer auf hochrechnen bis kein Leerzeichen mehr folgt
' so können dem Klammer auf kein, bis beliebig viele Leerzeichen folgen
Do
iPos = iPos + 1
Loop Until Mid(Range("A" & lZeile).Value, iPos, 1) <> " "
' die Zeichen ab Position Kunden-Nr einzeln übernehmen und an die neue
' Zelle übergeben, bis Klammer zu gefunden wird.
For iWoPos = iPos To Len(Range("A" & lZeile).Value)
sWoZei = Mid(Range("A" & lZeile).Value, iWoPos, 1)
If sWoZei <> ")" Then ' auf Klammer zu verproben
Range("B" & lZeile).Value = Range("B" & lZeile).Value & sWoZei
Else
Exit For ' Leerzeichen gefunden => For/Next verlassen
End If
Next iWoPos ' nächste Wort-Position
End If
Next lZeile ' nächste Zeile bearbeiten
End Sub