Text-Datei mit vielen Kopfzeilen drin importieren

Forumthread: Text-Datei mit vielen Kopfzeilen drin importieren

26.02.2004 17:27:10

Torsten

Hallo!
Hat jemand `ne Idee für ein Makro, mit dem ich eine Text-Datei mit folgendem Aufbau in Excel importieren kann? (Brauch ich sehr oft.)
Aufbau Text-Datei:
- Felder durch ein ; abgetrennt, es gibt keine Zeilenumbrüche.
- Erst kommen 24 Felder vor den eigentlichen Werten (Kopfzeile), welche rausfliegen sollen, dann 480 Felder mit den Daten (immer 5 Felder hintereinander sollen in eine Zeile).
- Danach kommen wider die 24 Felder, die raussollen usw.
Es soll praktisch eine Excel-Datei mit 5 Spalten im Endeffekt rauskommen.
Beim normalen Import gibt Excel nur eine Fehlermeldung wege zu viele Werten (sicher die Spalten).
Es sind halt sehr viele Werte; ein Bearbeiten von Hand wäre Wahnsinn.
Vielen Dank im voraus !!!
Torsten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Text-Datei mit vielen Kopfzeilen drin importieren

26.02.2004 18:19:51

axel.meyer

hi torsten
dieser makroteil ist derjenige, der eine "zu breite" txt-datei splittet und untereinander setzt. vielleicht nützt es dir ja und du kannst das makro auf deine bedürfnisse anpassen.
gruß, axel


Sub t()
' hier ersteinmal den dateinamen festlegen
Open dateiname For Input As #1
Do Until EOF(1)
Line Input #1, sTxt
arr = fncSplit(sTxt, ",")
For iCol = 0 To UBound(arr)
iRow = Fix(iCol / 256) * 600 + 1 + iPlus
iColT = iCol Mod 256 + 1
'treshold?
Cells(iRow, iColT).Value = arr(iCol)
Next iCol
iPlus = iPlus + 1
n = n + 1
Loop
Close
iRow = 0
iColT = 0
iCol = 0
arr = 0
n = 0
iPlus = 0
End Sub


Function fncSplit(SplitText As String, Delimiter As Variant) As Variant
Dim iFile As Integer, iCounter As Integer
Dim arr() As String
Dim sTxt As Double
Dim wer1 As Integer, wer2 As Integer
Do While SplitText <> ""
ReDim Preserve arr(iCounter)
If InStr(SplitText, Delimiter) Then
sTxt = Left(SplitText, _
InStr(SplitText, Delimiter) - 1)
'wer1 = CInt(sTxt)
If sTxt < treshold Then
sTxt = "0"
End If
arr(iCounter) = sTxt
SplitText = Right(SplitText, Len(SplitText) - InStr(SplitText, Delimiter))
Else
'wer2 = CInt(SplitText)
If SplitText < treshold Then
SplitText = "0"
End If
arr(iCounter) = SplitText
SplitText = ""
End If
iCounter = iCounter + 1
Loop
fncSplit = arr
End Function

AW: Text-Datei mit vielen Kopfzeilen drin importieren

27.02.2004 00:30:11

Josef Ehrensberger

Hallo Torsten!
Probier mal diesen Code.

Sub TextImport()
Dim iRow As Long, iCol As Integer, lngC As Long
Dim sFile As String, sTxt As String, varTxt() As Variant
On Error GoTo ERRORH
sFile = Application.GetOpenFilename("Text Files (*.txt;*.csv;*.dat), *.txt;*.csv;*.dat")
   If Dir(sFile) = "" Then
   Beep
   MsgBox "Datei wurde nicht gefunden!"
   GoTo ERRORH
   End If
Application.ScreenUpdating = False
Application.StatusBar = "Lese Datei  -  Bitte Warten"
iRow = 1
iCol = 1
Close
Open sFile For Input As #1
   Do Until EOF(1)
   Line Input #1, sTxt
      Do While InStr(sTxt, ";")
      lngC = lngC + 1
      sTxt = Right(sTxt, Len(sTxt) - InStr(sTxt, ";"))
      Loop
   Loop
Close
ReDim varTxt(lngC - 1)
lngC = 0
Open sFile For Input As #1
   Do Until EOF(1)
   Line Input #1, sTxt
      Do While InStr(sTxt, ";")
      varTxt(lngC) = Left(sTxt, InStr(sTxt, ";") - 1)
      lngC = lngC + 1
      sTxt = Right(sTxt, Len(sTxt) - InStr(sTxt, ";"))
      Loop
   Loop
Close
lngC = 23
   Do
   lngC = lngC + 1
   Application.StatusBar = "Importiere Datensatz " & Format(lngC, "#,##0") & " von " & _
      Format(UBound(varTxt), "#,##0") & " ( " & Int(lngC / UBound(varTxt) * 100) & _
      " % ) -  Bitte Warten"
   Cells(iRow, iCol) = varTxt(lngC)
   iCol = iCol + 1
      If iCol > 5 Then
      iRow = iRow + 1
      iCol = 1
      End If
      If lngC Mod 504 = 0 Then
      lngC = lngC + 23
      End If
   Loop While lngC < UBound(varTxt)
ERRORH:
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Gruß Sepp

Ein kluger Mann macht nicht alle Fehler selbst.
Er lässt auch anderen eine Chance.
(Sir Winston Churchill)

Korrektur!

27.02.2004 00:49:23

Josef Ehrensberger

Hallo Thorsten!
Da war noch ein Fehler beim Sprung über die Kopfdaten!
So tut's

Sub TextImportSpecial()
'Import einer Textdatei
'start bei Datensatz 24 bis 480
'sprung zu 528 bis 1004 usw....
Dim iRow As Long, iCol As Integer, lngC As Long
Dim sFile As String, sTxt As String, varTxt() As Variant
On Error GoTo ERRORH
sFile = Application.GetOpenFilename("Text Files (*.txt;*.csv;*.dat), *.txt;*.csv;*.dat")
   If Dir(sFile) = "" Then
   Beep
   MsgBox "Datei wurde nicht gefunden!"
   GoTo ERRORH
   End If
Application.ScreenUpdating = False
Application.StatusBar = "Lese Datei  -  Bitte Warten"
iRow = 1
iCol = 1
Close
Open sFile For Input As #1
   Do Until EOF(1)
   Line Input #1, sTxt
      Do While InStr(sTxt, ";")
      lngC = lngC + 1
      sTxt = Right(sTxt, Len(sTxt) - InStr(sTxt, ";"))
      Loop
   Loop
Close
ReDim varTxt(lngC - 1)
lngC = 0
Open sFile For Input As #1
   Do Until EOF(1)
   Line Input #1, sTxt
      Do While InStr(sTxt, ";")
      varTxt(lngC) = Left(sTxt, InStr(sTxt, ";") - 1)
      lngC = lngC + 1
      sTxt = Right(sTxt, Len(sTxt) - InStr(sTxt, ";"))
      Loop
   Loop
Close
lngC = 23
   Do
      lngC = lngC + 1

      If lngC Mod 504 = 0 Then
         lngC = lngC + 24
      End If


   Application.StatusBar = "Importiere Datensatz " & Format(lngC, "#,##0") & " von " & _
      Format(UBound(varTxt), "#,##0") & " ( " & Int(lngC / UBound(varTxt) * 100) & _
      " % ) -  Bitte Warten"
   Cells(iRow, iCol) = varTxt(lngC)
   iCol = iCol + 1
      If iCol > 5 Then
      iRow = iRow + 1
      iCol = 1
      End If
   Loop While lngC < UBound(varTxt)
ERRORH:
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Gruß Sepp

Ein kluger Mann macht nicht alle Fehler selbst.
Er lässt auch anderen eine Chance.
(Sir Winston Churchill)

Beliebteste Forumthreads (12 Monate)

Text-Datei mit vielen Kopfzeilen drin importieren

Forumthread: Text-Datei mit vielen Kopfzeilen drin importieren

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Text-Datei mit vielen Kopfzeilen drin importieren

Forumthread: Text-Datei mit vielen Kopfzeilen drin importieren

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread