|
So sollte es funktionieren:
Option Explicit
'Verweis auf "Microsoft VBScript Regular Expressions 5.5" setzen
Private Const REGEXPATTERN As String = "\s{0,}FROM\s{0,}" 'ggfs. anpassen: "https://regex101.com/"
Private Const TABLENAME_FROM As String = "Tabelle1" 'anpassen
Private Const TABLENAME_TO As String = "Tabelle2" 'anpassen
Public Sub search_and_transfer()
Dim regEx As New RegExp
With regEx
.Pattern = REGEXPATTERN
.Global = True
.IgnoreCase = False 'ggfs. anpassen (Groß- Kleinschreibung ignorieren)
.MultiLine = False
End With
Dim l As Long
l = 1
With Worksheets(TABLENAME_FROM)
Do While Not .Cells(l, 1).Value = vbNullString
If regEx.test(.Cells(l, 1).Value) Then
Worksheets(TABLENAME_TO).Cells(get_next_empty_row, 1).Value = Replace(Left(regEx.Replace(.Cells(l, 1), ""), InStr(1, regEx.Replace(Trim(.Cells(l, 1)), ""), " ", vbTextCompare) - 1), Chr(160), vbNullString)
End If
l = l + 1
Loop
End With
Set regEx = Nothing
End Sub
Private Function get_next_empty_row() As Long
Dim l As Long
l = 1
With Worksheets(TABLENAME_TO)
Do While Not .Cells(l, 1).Value = vbNullString
l = l + 1
Loop
End With
get_next_empty_row = l
End Function
Gruß
|