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