Hallo,
man sollte die Anforderung auch komplett lesen, hier nun erweitert:
Option Explicit
'Verweis auf "Microsoft VBScript Regular Expressions 5.5" setzen
Private Const REGEXPATTERN As String = "from\s" '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 = True '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 = Left(regEx.Replace(.Cells(l, 1), ""), InStr(1, regEx.Replace(.Cells(l, 1), ""), " ", vbTextCompare) - 1)
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ß
|