Gruppe
Extern
Problem
Aus einer Textdatei soll jeweils die erste in Klammern stehende Zeichenfolge ausgelesen werden.
StandardModule: Modul1
Sub ParseTxt()
Dim var As Variant
Dim lCounter As Long
Dim iRow As Integer
Dim sFile As String, sTxt As String
Dim bln As Boolean
Application.ScreenUpdating = False
bln = Application.DisplayStatusBar
Application.DisplayStatusBar = True
sFile = Range("E1").Value
If Dir(sFile) = "" Then
Beep
MsgBox "Datei " & sFile & " wurde nicht gefunden!"
Exit Sub
End If
On Error GoTo ERRORHANDLER
Close
Open sFile For Input As #1
Do Until EOF(1)
lCounter = lCounter + 1
If lCounter Mod 100 = 0 Then
Application.StatusBar = "Bearbeite Zeile " & lCounter & "..."
End If
Line Input #1, sTxt
sTxt = Right(sTxt, Len(sTxt) - InStr(sTxt, "("))
sTxt = Left(sTxt, InStr(sTxt, ")") - 1)
var = Application.Match(sTxt, Columns(1), 0)
If IsError(var) Then
iRow = iRow + 1
Cells(iRow, 1).Value = sTxt
Cells(iRow, 2).Value = 1
Else
Cells(var, 2).Value = Cells(var, 2).Value + 1
End If
Loop
ERRORHANDLER:
Close
Application.StatusBar = False
Application.DisplayStatusBar = bln
Application.ScreenUpdating = True
End Sub