Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Textdatei (mit Überschriften) in Excel einlesen

Textdatei (mit Überschriften) in Excel einlesen
31.01.2014 11:21:44
Constantin
Hallo,
ich möchte eine txt-Datei (ca. 40.000 Zeilen), nach Excel einlesen. Diese txt-Datei besteht aus vielen Einzelberichten, die nacheinander folgen und jeweils mehrzeilige Überschriften auf jeder Berichtsseite haben. Da jeder Einzelbericht eine bestimmte Abteilung betrifft, möchte ich diese Informationen aus der Überschrift mit nach Excel übertragen. Die beigefügte Musterdatei zeigt die Ausgangsstruktur.
https://www.herber.de/bbs/user/89044.txt
Wie könnte so ein Programmaufbau aussehen, der es mir ermöglicht, dass der „Schleifenwechsel“ bei jeder neuen Abteilung beginnt? Diese Information steht erstmalig in Zeile 6 der Überschrift und beginnt bei Zeichen 72, Länge 12.
Was für mich auch noch eine (ungelöste) Herausforderung darstellt, ist, wie sich das Minuszeichen (rechts) in den Wertspalten berücksichtigen lässt und wie die Tausenderpunkte in der Textdatei bei den Werten behandelt werden müssen.
Ich würde mich über einen Tipp oder Lösungsansatz sehr freuen.
Grüße, Constantin
Hier noch das „Ergebnisformat“ in Excel mit den Positionen und Längen in der Textdatei:
Der Inhalt der Spalten aus der Überschrift:
Zuständig: 72, 20 (beginnt bei Zeichen 72 mit der Länge 20)
Bereich: 72, 10
Abteilung: 72, 12
Bezeichnung: 72, 40
Monat: 23, 5
Kalenderjahr: 21, 4
Der Inhalt der Spalten aus den Wertzeilen:
IST Periode: 2, 12 (beginnt bei Zeichen 2 mit der Länge 12)
Plan Periode: 15, 12
Abweichung Periode: 28, 11
Abweichung Periode in %: 40, 7
Kostenart: 48, 35
IST kum.: 84, 12
Plan kum.: 97, 12
Abweichung kum.: 110, 11
Abw.kum in %: 122, 7

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Textdatei (mit Überschriften) in Excel einlesen
31.01.2014 12:53:53
Rudi
Hallo,
als Ansatz:
Sub aaa()
Dim arrTxt, tmp, i As Long, j As Integer, n As Long, arrDaten()
Dim strZust, strBereich As String
Open "c:\test\89044.txt" For Input As #1  'anpassen
arrTxt = Split(Input(LOF(1), 1), vbCrLf)
Close #1
ReDim arrDaten(1 To 15, 1 To UBound(arrTxt))
Do While i  0 Then
strBereich = Trim(Mid(tmp, InStr(tmp, "Bereich:") + 9, 30))
tmp = arrTxt(i - 1)
strZust = Trim(Mid(tmp, InStr(tmp, "zuständig:") + 11, 30))
'etc
i = i + 6
Else
tmp = Split(arrTxt(i), "|")
If UBound(tmp) = 10 Then
If IsNumeric(Trim(Replace(tmp(1), "-", ""))) Then
n = n + 1
arrDaten(1, n) = strBereich
arrDaten(2, n) = strZust
'etc
For j = 1 To 9
arrDaten(j + 6, n) = Trim(tmp(j))
Next
End If
End If
End If
Loop
ReDim Preserve arrDaten(1 To UBound(arrDaten), 1 To n)
arrDaten = WorksheetFunction.Transpose(arrDaten)
Worksheets.Add.Cells(1, 1).Resize(UBound(arrDaten), UBound(arrDaten, 2)) = arrDaten
End Sub
Gruß
Rudi

Anzeige
AW: Textdatei (mit Überschriften) in Excel einlesen
31.01.2014 15:59:35
fcs
Hallo Constantin,
hier mein Vorschlag.
Die Daten werden zunächst importiert und am "|" in Spalten aufgetrennt. Die zahlenformate werden beim Import schon korrekt erkannt und ggf. umformatiert.
Danach werden dann die Kopfzeilen ausgewertet und die Informationen in zusätzliche Spalten eingetragen.
Alle nicht benötigten Zeilen werden am Ende gelöscht.
Ich bin mir aber nicht sicher ob das Makro ohne Probleme mit 40000 Datenzeilen fertig wird. Zum testen hatte ich mir eine Text-Datei mit ca. 65 Zeilen gebastelt.
Die so erstellte Liste kann man dann ggf. weiter verarbeiten.
Gruß
Franz
Sub ImportMonatsbericht()
' ImportMonatsbericht Makro
Dim wksImp As Worksheet
Dim lngZ As Long, lngS As Long, Zeile_L As Long
Dim varDatum, varZustaendig, varBereich
Dim varMonVon, varMonBis, varAbt, varJahr, varBezeichnung
Dim varFileTXT, strText As String
Dim bolTitel
Dim arrData
'Textdatei auswählen
varFileTXT = Application.GetOpenFilename(Filefilter:="Text-Datei (*.txt),*-txt", _
Title:="Bitte Kostenbericht-Text-Datei für Import auswählen")
If varFileTXT  False Then
'Neues Blatt für importierte Daten anlegen
ActiveWorkbook.Worksheets.Add after:=ActiveSheet
Application.ScreenUpdating = False
Set wksImp = ActiveSheet
'Textdaten importieren mit Spaltentrennung am Zeichen "|"
With wksImp.QueryTables.Add(Connection:="TEXT;" & varFileTXT, _
Destination:=wksImp.Range("$A$1"))
.Name = "KstBericht" & Format(Now, "YYYYMMDDhhmmss")
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 2, 1, 1, 1, 1, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With wksImp
Zeile_L = .UsedRange.Row + .UsedRange.Rows.Count - 1
'Zellbereich mit Daten plus leere Spalten für Titel in Array einlesen
arrData = .Range(.Cells(1, 1), .Cells(Zeile_L, 17))
'Importierte Daten aufbereiten
For lngZ = 1 To Zeile_L
If VBA.Trim(arrData(lngZ, 1)) = "" Then
'Zeile löschen, wenn 1. Spalte nur Leerzeichen enthält
ElseIf InStr(1, arrData(lngZ, 1), " Kostenbericht (") > 0 Then
'" Kostenbericht (" = Kennzeichen für neue Seite
If bolTitel = False Then
arrData(lngZ, 1) = Trim(arrData(lngZ, 1))
arrData(lngZ, 17) = True
End If
'Kopfzeilendaten auslesen
strText = arrData(lngZ + 2, 1)
varDatum = Mid(strText, InStr(1, strText, "Datum:") + 7, 10)
varZustaendig = Trim(Mid(strText, InStr(1, strText, "zuständig:") + 11))
strText = arrData(lngZ + 3, 1)
varBereich = Trim(Mid(strText, InStr(1, strText, "Bereich:") + 9))
strText = arrData(lngZ + 4, 1)
varMonVon = Trim(Mid(strText, InStr(1, strText, "Monat:") + 6, 7))
varMonBis = Trim(Mid(strText, InStr(1, strText, "bis") + 3, 7))
varAbt = Trim(Mid(strText, InStr(1, strText, "Abteilung:") + 10))
strText = arrData(lngZ + 5, 1)
varJahr = Trim(Mid(strText, InStr(1, strText, "jahr:") + 5, 8))
varBezeichnung = Trim(Mid(strText, InStr(1, strText, "Bezeichnung:") + 12))
'Zeileninhalte löschen, wenn in 1. Spalte bestimmte Inhalte vorhanden sind
ElseIf InStr(1, arrData(lngZ, 1), "---") > 0 Then
ElseIf InStr(1, arrData(lngZ, 1), "Datum:") > 0 Then
ElseIf InStr(1, arrData(lngZ, 1), "Bereich:") > 0 Then
ElseIf InStr(1, arrData(lngZ, 1), "Monat:") > 0 Then
ElseIf InStr(1, arrData(lngZ, 1), "Kalenderjahr:") > 0 Then
ElseIf InStr(1, arrData(lngZ, 1), "Seite:") > 0 Then
ElseIf InStr(1, arrData(lngZ, 1), "Ist Per.") > 0 Then
'Spaltentitel beim 1. auftreten nicht löschen
If bolTitel = False Then
arrData(lngZ, 17) = True
'äußere Leerzeichen in Spaltentiteln entfernen
For lngS = 1 To 9
arrData(lngZ, lngS) = Trim(arrData(lngZ, lngS))
Next
'Spaltentitel erweitern um Infos aus Kopfzeilen
lngS = 10 'lngS J
arrData(lngZ, lngS) = "Monat von": lngS = lngS + 1
arrData(lngZ, lngS) = "Monat bis": lngS = lngS + 1
arrData(lngZ, lngS) = "Jahr": lngS = lngS + 1
arrData(lngZ, lngS) = "Bereich": lngS = lngS + 1
arrData(lngZ, lngS) = "zuständig": lngS = lngS + 1
arrData(lngZ, lngS) = "Abteilung": lngS = lngS + 1
arrData(lngZ, lngS) = "Bezeichnung": lngS = lngS + 1
bolTitel = True
End If
Else
arrData(lngZ, 17) = True
'äußere Leerzeichen bei Kostenart entfernen
arrData(lngZ, 5) = Trim(arrData(lngZ, 5))
'Kopfzeilendaten in Zeile eintragen
lngS = 10 'lngS J
arrData(lngZ, lngS) = varMonVon: lngS = lngS + 1
arrData(lngZ, lngS) = varMonBis: lngS = lngS + 1
arrData(lngZ, lngS) = varJahr: lngS = lngS + 1
arrData(lngZ, lngS) = varBereich: lngS = lngS + 1
arrData(lngZ, lngS) = varZustaendig: lngS = lngS + 1
arrData(lngZ, lngS) = varAbt: lngS = lngS + 1
arrData(lngZ, lngS) = varBezeichnung: lngS = lngS + 1
End If
Next
'Daten aus Array in Tabelle zurückschreiben
.Range(.Cells(1, 1), .Cells(Zeile_L, 17)) = arrData
'leere Zeilen löschen
With .Range(.Cells(1, 17), .Cells(Zeile_L, 17))
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlShiftUp
End With
.Columns(17).Delete
'Spaltenbreiten setzen
.Columns.AutoFit
.Columns(1).ColumnWidth = 10
'Fenster unter der Titelzeile fixieren
Application.ScreenUpdating = True
Application.StatusBar = False
Range("A1").Select
Range("A3").Select
ActiveWindow.FreezePanes = True
End With
End If
End Sub

Anzeige
AW: Textdatei (mit Überschriften) / Nachfrage
31.01.2014 20:48:46
Constantin
Hallo Rudi, hallo Franz,
erst einmal vielen vielen Dank an euch für die tolle Unterstützung!
Ich bin momentan noch am Testen. In Rudi's Programm taucht bei mir an der Stelle bei arrDaten = WorksheetFunction.Transpose(arrDaten)noch eine Fehlermeldung auf "Laufzeitfehler 13 / Typen unverträglich".
Franz, das Programm läuft! Zwei Dinge gibt es noch für mich zu lösen: Die Anzahl Datensätze in der Rohdatei (txt) übersteigt die 65.000, d.h. mein Ansatz war zu niedrig. Kann ich das anpassen im Programm? Und wo müsste ich hinschauen, um zu prüfen, wenn die Zusatzspalten (Bereich, ...) aus dem Kopfteil nicht in die Zeilen übertragen werden? Die Zusatzspalten werden jedoch als Überschrift in Excel angelegt. Die eine oder andere Bezeichnung habe ich allerdings geringfügig noch angepasst, um sie neutraler bzw. verständlicher zu gestalten. Vielleicht könnte es auch daran liegen ...
Grüße, Constantin

Anzeige
AW: Textdatei (mit Überschriften) / Nachfrage
31.01.2014 21:37:31
Constantin
Hallo Franz,
gleich nochmal eine Zwischenstandsmeldung: Die Dateigröße ist kein Problem. Ich hatte versehentlich das Programm in einer Excel-Datei im Kompatibilitätsmodus gestartet.
Mit den Inhalten der Zusatzspalten bin ich noch am Testen.
Grüße, Constantin

AW: Textdatei (mit Überschriften) / Nachfrage
01.02.2014 03:37:11
fcs
Hallo Constantin,
die Inhalte der Kopfzeilen werden ja in folgendem Anschnitt ermittelt:
         ElseIf InStr(1, arrData(lngZ, 1), " Kostenbericht (") > 0 Then
'" Kostenbericht (" = Kennzeichen für neue Seite
If bolTitel = False Then
arrData(lngZ, 1) = Trim(arrData(lngZ, 1))
arrData(lngZ, 17) = True
End If
'Kopfzeilendaten auslesen
strText = arrData(lngZ + 2, 1)
varDatum = Mid(strText, InStr(1, strText, "Datum:") + 7, 10)
varZustaendig = Trim(Mid(strText, InStr(1, strText, "zuständig:") + 11))
strText = arrData(lngZ + 3, 1)
varBereich = Trim(Mid(strText, InStr(1, strText, "Bereich:") + 9))
strText = arrData(lngZ + 4, 1)
varMonVon = Trim(Mid(strText, InStr(1, strText, "Monat:") + 6, 7))
varMonBis = Trim(Mid(strText, InStr(1, strText, "bis") + 3, 7))
varAbt = Trim(Mid(strText, InStr(1, strText, "Abteilung:") + 10))
strText = arrData(lngZ + 5, 1)
varJahr = Trim(Mid(strText, InStr(1, strText, "jahr:") + 5, 8))
varBezeichnung = Trim(Mid(strText, InStr(1, strText, "Bezeichnung:") + 12))

Wenn der Text " Kostenbericht (" in Spalte A einer Zeile enthalten ist, dann wird dies als neue und 1. Zeile von Kopfdaten interpretiert. Falls du da etwas geändert hast, dann den Text in der ElseIf-Zeile anpassen.
Alle weiteren Inhalte werden dann relativ von dieser Zeile aus ermittelt.
Der gesamte Inhalt wird jeweils in die Variable strText eingelesen. Hier musst du bei Änderungen ggf. den (lngZ + Wert) anpassen
Dannach werden dann die relevanten Inhalte mit der Mid-Funktion herausgeschnitten, wobei die Startposition des Inhalts an Hand der Bezeichnung des Inhalts ermittelt wird. Hier musst du ggf. den Suchbegriff und nach dem Pluszeichen die Länge des Suchbegriffs anpassen oder du gibst die Startposition des Inhalts in der Zeile als nummerischen Wert fest vor. Die Trim-Funktion sorgt dafür, dass überzählige Leerzeichen am Beginn/Ende entfernt werden.
Damit du hier genau Anpassen kannst führe das Makro schrittweise aus bis die Daten importiert sind und brich dann das Makro ab, bevor die Daten weiter aufbereitet werden. Dann kannst du genau ermitteln, wie du einzelnne Daten in den Kopfzeilen einlesen kannst.
Gruß
Franz

Anzeige
AW: funktioniert! - vielen Dank.
01.02.2014 09:38:49
Constantin
Hallo Franz,
super - das hat mir geholfen. Es war die Klammer in der Überschrift, die bei mir anders gesetzt war.
Nochmals vielen Dank.
Grüße, Constantin

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige