AW: Zeilenanfang bei Wort suchen und Satz...
16.07.2020 12:28:57
Sten
Also ich versuche es noch einmal.
Diese Makro habe ich verwendet.
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
'Nach einer Idee von http://www.activevb.de
'Angepasst von J.Ehrensberger
Option Explicit
Sub sucheInTextFile()
Dim x As Long, Zeilen() As String, FName As String, sText As String
On Error GoTo ERRORHANDLER
Application.ScreenUpdating = False
FName = Application.GetOpenFilename("Text Dateien (*.txt)," & _
"*.txt")
If FName = "Falsch" Then GoTo ERRORHANDLER
sText = InputBox("Bitte Suchtext eingeben", "Suche", "") 'Suchtext
If sText = "" Then Exit Sub
Range("A:A").ClearContents 'Datenbereich löschen
'Die letzten beiden Parameter geben das linke und rechte
'Begrenzungszeichen einer Zeile an, dies können auch
'mehrere sein. Hier wurde für links und rechts "D" gewählt!
If FindTerm(FName, sText, Zeilen, "D", "D") Then
For x = 0 To UBound(Zeilen) - 1
Cells(x + 1, 1) = Trim$(Zeilen(x))
Next
MsgBox "Es wurden " & UBound(Zeilen) & " Zeilen gefunden!"
Else
MsgBox "Suchbegriff nicht vorhanden!"
End If
ERRORHANDLER:
If Err.Number > 0 Then
MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"
End If
Application.ScreenUpdating = True
End Sub
Private Function FindTerm(File As String, s As String, ZZ() As String, _
tl As String, tr As String) As Boolean
Dim c As Long, i As Long, j As Long
Dim FLen As Long, lc As Long, p As Long
Dim v As Long, w As Long
Dim f As Integer
Dim a As String, d As String
Dim buffer As String, old As String
'Dieser Wert gibt die Paketgröße von Get# an. Er kann beliebig
'geändert werden, sollte aber nicht kleiner als die längste
'zu erwartende Zeile des zu druchsuchenden Files sein
Const PS As Long = 1024&
Redim ZZ(0)
'Prüfen ob Parameter plausibel sind
If Len(tl) = 0 Or Len(tr) = 0 Or Len(s) = 0 Or _
Dir$(File, vbNormal) = "" Then
MsgBox ("Paramter stimmen nicht!")
Exit Function
End If
s = LCase(s)
f = FreeFile
Open File For Binary Shared As #f
FLen = LOF(f)
'Anzahl der Durchläufe anhand der Dateigröße ermitteln
p = FLen \ PS
If FLen Mod PS 0 Then p = p + 1
'Schleife starten
For c = 1 To p
buffer = Space$(PS)
Get f, , buffer
a = old & buffer
i = InStr(1, LCase(a), s)
If i 0 Then
'Suchbegriff wurde im aktuellen Paket gefunden
lc = 0
Do
i = InStr(i, LCase(a), s)
If i 0 Then
'Zeilenanfang suchen
v = 1
For j = i To 1 Step -1
d = Mid$(a, j, 1)
'gefunden
If InStr(1, tl, d) Then
v = j + 1
Exit For
End If
Next j
'Zeilenende suchen
w = 0
For j = i To Len(a)
d = Mid$(a, j, 1)
'gefunden
If InStr(1, tr, d) Then
w = j
Exit For
End If
Next j
If w 0 Then
' Zeile auschneiden und in einem Feld speichern
' Hier könnten auch weitere Suchkriterien abge-
' fragt werden.
ZZ(UBound(ZZ)) = Mid$(a, v, w - v)
Redim Preserve ZZ(0 To UBound(ZZ) + 1)
lc = w
End If
i = w
End If
'Weiter schleifen, da der Suchbegriff im Paket ja
'öfters als einmal auftauchen kann
Loop Until i = 0
If lc = 0 Then
'Suchbegriff wurde im aktuellen Paket nicht ge-
'funden. Daher ganzen String für die nächste Runde
'speichern
old = a
Else
'Ab Ende der zuletzt gefundenen Zeile des aktuel-
'len Paketes für die nächste Runde speichern
old = Mid$(a, lc)
End If
Else
'Paket der aktuellen Runde speichern
old = buffer
End If
Next c
Close f
If UBound(ZZ) > 0 Then FindTerm = True
End Function
Darin gibt es den Abschnitt zur Definition der Bereichsgrenzen
'Die letzten beiden Parameter geben das linke und rechte
'Begrenzungszeichen einer Zeile an, dies können auch
'mehrere sein. Hier wurde für links und rechts "D" gewählt!
If FindTerm(FName, sText, Zeilen, "D", "D") Then ....
Diese Formel akzeptiert aber nur 1 Zeichen zum auffinden der Satzgrenzen.
In meiner Textdatei ist nur die Zeichenfolge "------------ usw." als klarer Trenner zwischen den Sätzen vorhanden. Mir würde es reichen wenn ich die das ganze so anpassen könnte das er als Begrenzer nicht nur 1 Zeichen akzeptiert sondern einen beliebige Zeichenkette.
So in der Form etwa
If FindTerm(FName, sText, Zeilen, "ABC", "DEF") Then ....
Und an diesem Punkt komme ich nicht weiter.