Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1392to1396
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Trennzeichen bei .dat files

Trennzeichen bei .dat files
01.12.2014 10:07:44
Annabelle
Hallo,
ich habe ein Makro, dass .dat Files einliest. Dieses funktioniert auch wunderbar, jedoch möchte ich nun auch noch andere dat Files einlesen. Die Daten darin sind jedoch mit einem Leerzeichen jeweils abgetrennt. Ich habe leider keine Idee wie ich das in meinem bisherigen Makro ändere. Ich hatte an sich gedacht, dass ich es hier ändere: .TextFileTabDelimiter = True also einfach Tab durch Space ersetze, das funktioniert jedoch nicht.
Ich wäre froh über Hilfe
Danke schonmal
Gruß
Annabelle
Anbei mein bisheriger Quellcode:
Sub hist_Datenimport()
MsgBox "Alle Daten werden gelöscht"
Cells.Select
Selection.Clear
Dim intRow As Long
Dim Zahl As Long
Dim letztespalte As Long
Dim strVerzeichnis As String
Dim Pixel As Long
Dim strDateiname As String
Dim strFeld As String
Dim letzteZeile As Long
Dim lngSpalte As Long
Dim blnWithHeader As Boolean
Dim Zelle As Range
Dim AppShell As Object
Dim BrowseDir As Variant
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
On Error Resume Next
strVerzeichnis = BrowseDir.items().Item().Path
If strVerzeichnis = "" Then Exit Sub
On Error GoTo 0
lngSpalte = 2
Zahl = 1
Pixel = 1
blnWithHeader = True
If Right$(strVerzeichnis, 1) "\" Then strVerzeichnis = strVerzeichnis & "\"
strDateiname = Dir(strVerzeichnis & "*.dat")
Application.ScreenUpdating = False
Do While strDateiname vbNullString
strFeld = Left$(strDateiname, Len(strDateiname) - 4)
Call Import(Cells(1, lngSpalte), strVerzeichnis & strDateiname, strFeld, blnWithHeader)
lngSpalte = lngSpalte + 1
If blnWithHeader Then blnWithHeader = False
strDateiname = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Sub Import(rngZielZelle As Range, strDatienamenPfad As String, strFeld As String, Optional blnWithHeader As Boolean)
Dim rngZiel As Range
Dim rngFeld As Range
Dim avarTextFileColumnDataTypes As Variant
Dim laengen(100) As Long
Dim werte(100, 1000)
If blnWithHeader Then
Set rngFeld = rngZielZelle
Set rngZiel = rngZielZelle.Offset(1, -1)
avarTextFileColumnDataTypes = Array(1, 1, 1)
Else
Set rngFeld = rngZielZelle
Set rngZiel = rngZielZelle.Offset(1)
avarTextFileColumnDataTypes = Array(9, 1, 1)
End If
rngFeld.Value = strFeld
Call TextTesten(strDatienamenPfad)
With rngZielZelle.Worksheet.QueryTables.Add(Connection:="TEXT;" & strDatienamenPfad, Destination:=rngZiel)
.RefreshStyle = xlOverwriteCells
.SaveData = False
.AdjustColumnWidth = False
.TextFilePlatform = 850
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileTabDelimiter = True
.TextFileColumnDataTypes = avarTextFileColumnDataTypes
.Refresh BackgroundQuery:=False
.Delete
letztespalte = Cells(30, Columns.Count).End(xlToLeft).Column
For intRow = 2 To letztespalte
letzteZeile = ActiveSheet.Cells(1048576, intRow).End(xlUp).Row
laengen(intRow - 1) = letzteZeile
For Zeile = 2 To letzteZeile
werte(intRow - 1, Zeile - 1) = Cells(Zeile, intRow)
Next
If letzteZeile > Pixel Then
Pixel = letzteZeile
End If
Next
For Zahl = 2 To Pixel
Cells(Zahl, 1).Value = Zahl - 1
Next Zahl
End With
' Text-Zahl in Zahl umwandeln + formatieren
With rngFeld.Offset(1).Resize(rngFeld.Worksheet.Rows.Count - rngFeld.Row)
.Replace ".", ".", xlPart
.NumberFormat = "#,##0.0000"
End With
Set rngFeld = Nothing
Set rngZiel = Nothing
End Sub

Public Sub TextTesten(sPfad As String)
'Dim sPfad As String,
Dim sText As String
sText = dat_ReadText(sPfad)
'Wenn "." im Text dann ists US Format und umwandeln
If InStr(sText, ".") Then
sText = Replace(sText, ",", "")
sText = Replace(sText, ".", ",")
dat_WriteText sPfad, sText
End If
End Sub


Public Function dat_ReadText(DerPfad As String) As String
Dim sText As String, iFrei As Integer, i As Long
On Error GoTo Fehler
sText = ""
iFrei = FreeFile
Open DerPfad For Binary Access Read As #iFrei
i = LOF(iFrei)
sText = String(i, 0)
Get #iFrei, , sText
Close #iFrei
dat_ReadText = sText
Exit Function
Fehler:
MsgBox Err.Description
End Function


Public Sub dat_WriteText(DerPfad As String, DerText As String)
Dim iFrei As Integer
On Error GoTo Fehler
iFrei = FreeFile
Open DerPfad For Output As #iFrei
Print #iFrei, DerText;
Close #iFrei
Exit Sub
Fehler:
MsgBox Err.Description
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Die SubProz 'Import' wird ja schon parametriert...
01.12.2014 12:46:06
Luc:-?
…aufgerufen, Annabelle,
weshalb es sich anbietet, dem noch einen optionalen Parameter hinzuzufügen, der den TextFileDelimiter angibt. Standardmäßig ist ohnehin Tab vorgesehen (angehakt), also True. Die 3 anderen separat aufgeführten sind False. Wird also dieser zusätzliche Parameter nicht angegeben, wird der Delimiter im Pgm gar nicht erst aufgeführt. Fktt das nicht, könnte in diesem Fall auch 0 gesetzt wdn. Ansonsten sollte eine der Zahlen 1…3 oder für den Sonderfall der Delimiter direkt als Text angegeben wdn, weshalb dieser Parameter Variant sein sollte (der Schreibfehler bei DatienamenPfad könnte auch mal im gesamten Pgm korrigiert wdn!):
Import(rngZielZelle As Range, ByVal strDatienamenPfad As String, ByVal strFeld As String, Optional ByVal blnWithHeader As Boolean, Optional ByVal DatTrennZNr)
In diesem Pgm dann bspw noch eine Variant-Variable TrennVar deklarieren und mit einem Array aus Arrays belegen:
TrennVar = Array(Array(True, False, False, False, False), Array(False, True, False, False, False), Array(False, False, True, False, False), Array(False, False, False, True, False), Array(False, False, False, False, True))
Eine weitere Variant-Variable Trenner wird dann mit dem lt DatTrennZNr gewünschten Teil-Array belegt:
If IsNumeric(DatTrennZNr) Then Trenner = TrennVar(DatTrennZNr) Else Trenner = TrennVar(4)
Im weiteren PgmVerlauf wdn neben .TextFileTabDelimiter auch noch die 3 anderen FestMöglichkeiten aufgeführt und ihnen der entsprechende Wert aus Trenner zugewiesen:
.TextFileTabDelimiter = Trenner(0)
.TextFileSemicolonDelimiter = Trenner(1)
.TextFileCommaDelimiter = Trenner(2)
.TextFileSpaceDelimiter = Trenner(3)
.TextFileOtherDelimiter = Trenner(4)

Wenn der letzte Delimiter=True ist, wird DatTrennZNr (dann TextZeichen) direkt als Delimiter verwendet, wofür wohl noch der entsprd Befehl ergänzt wdn müsste.
Etwas einfacher wäre es ggf, wenn nur zwischen der Standardmöglichkeit (Tab) und freier Delimiter-Angabe unterschieden wdn könnte. Dann müsste wohl statt .TextFileTabDelimiter-Angabe nur diese letzte Möglichkeit vorgesehen wdn und DatTrennZNr würde entweder fehlen oder als TextZeichen angegeben wdn müssen: .TextFileOtherDelimiter = Not IsMissing(DatTrennZNr)
Unter If .TextFileOtherDelimiter Then … End If dann den anderen Delimiter aus DatTrennZNr in die vorgesehene Eigenschaft übernehmen. Das musst du dir dann bitte mal selbst in VBE-Hilfe und VBE-Objekt-Explorer zusammensuchen.
Gruß, Luc :-?
Besser informiert mit …
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige