Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1448to1452
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

VBA: Text-Datei nach Excel

VBA: Text-Datei nach Excel
18.09.2015 18:02:42
Emre
Hallo zusammen,
bräuchte wieder mal eure Hilfe. Es geht um einen Code den ich bereits bisschen angepasst habe aber er macht immer noch nicht genau das was ich brauche.
Also, ich muss Werte aus einer txt.-Datei zu Excel per VBA kopieren/importieren. Das Problem ist, die txt.-Datei hat keine richtige Struktur und ist sehr blöd aufgebaut.
Die txt.-Datei sieht folgendermaßen aus, die Werte sind Beispiele von mir.

Performanz Analyse:
------------------------
Gescannte Werte:
10023: Diese Datei wurde "gescannt" , 10024: [Dieser Wert wurde gescannt] , 10025: Diese Datei wurde gescannt , 10023: Diese Datei wurde gescannt , 10023: Diese Datei wurde gescannt , 10023: Diese Datei wurde gescannt , 10023: Diese Datei wurde gescannt , 10023: Diese Datei wurde gescannt , 10023: Diese Datei wurde gescannt ,
Große Analyse:
------------------------
Ist beeinflusst:
10026: [Diese] Datei wurde "gescannt"
10044: [Dieser Wert wurde gescannt]
14025: Diese Datei wurde gescannt
10043: Diese Datei wurde gescannt
10423: Diese Datei wurde gescannt
10423: Diese Datei wurde gescannt
10013: Diese Datei wurde gescannt
Gescannte Werte:
================
10423: Diese Datei wurde gescannt
10013: Diese Datei wurde gescannt

Der Teil "Performanz Analyse" soll in Excel untereinander aufgelistet werden (was ich eigentlich schaffe) und hat um die 1000 Werte in der Originaldatei. Aber die beiden nächsten Teile "Große Analyse" und "Gescannte Werte" nimmt mein Code nicht mit. Ich bekomme auch noch einen Laufzeitfehler 1004 aber, wie gesagt der erste Teil wird trotzdem zu Excel übernommen.
Wäre für eure Hilfe sehr dankbar. Das hier ist mein Code:
Sub Import_1()
Dim strPfad As String
Dim lngFN As Long
Dim strText As String
Dim vntArrayWerte As Variant
Dim wksZ As Worksheet
Dim intFileNumber As Integer
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
With .Filters
If .Count > 0 Then .Clear
Call .Add("Textdateien", "*.txt")
End With
If .Show Then
intFileNumber = FreeFile
Open .SelectedItems(1) For Binary As #intFileNumber
strText = Space(LOF(intFileNumber))
Get #intFileNumber, 1, strText
Close #intFileNumber
vntArrayWerte = Split(strText, " ,")
ThisWorkbook.Worksheets("txt.File").Cells(1, 1).Resize( _
UBound(vntArrayWerte) + 1) = Application.Transpose(vntArrayWerte)
End If
End With
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Text-Datei nach Excel
18.09.2015 22:23:53
Michael
Hi Emre,
nach dem Split enthält das letzte Feld des Arrays alles, was nach dem letzten " ," kommt, also die kompletten zwei folgenden Blöcke.
Da Du die Variable strText ja bereits ausgelesen hast, kannst Du sie für dieses letzte Feld verwenden, in etwa so: strText = vntArrayWerte(Ubound(vntArrayWerte))
Das Array würde ich dann mit Redim Preserve um dieses letzte Feld verkleinern, bevor Du das Transpose machst.
Den strText dröselst Du dann wiederum mit vntArrayWerte=Split(strText,vbcrlf)
nach Zeilenumbrüchen ins Array auf.
So in etwa, prinzipiell.
Schöne Grüße,
Michael

Anzeige
AW: VBA: Text-Datei nach Excel
19.09.2015 10:43:28
Emre
Hallo Michael,
danke für deine Antwort. Ich weiß leider nicht was das Redim Preserve ist und wie ich es verwenden soll. Besser gesagt, es hat sich nicht viel geändert nach dem Ändern des Codes jetzt.
Gruß
Emre

AW: VBA: Text-Datei nach Excel
20.09.2015 17:44:25
Michael
Hi Emre,
also, was redim preserve macht, kannst Du in der Hilfe selbst nachlesen.
Hier der Code:
Option Explicit
Sub Import_1()
Dim strPfad As String
Dim lngFN As Long, lngPos As Long
Dim strText As String, strAnfang As String
Dim vntArrayWerte As Variant
Dim wksZ As Worksheet
Dim intFileNumber As Integer
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
With .Filters
If .Count > 0 Then .Clear
Call .Add("Textdateien", "*.txt")
End With
If .Show Then
intFileNumber = FreeFile
Open .SelectedItems(1) For Binary As #intFileNumber
strText = Space(LOF(intFileNumber))
Get #intFileNumber, 1, strText
Close #intFileNumber
vntArrayWerte = Split(strText, ", ")      ' zuerst Komma, dann Leerzeichen
lngPos = InStr(vntArrayWerte(0), "Werte:")
If lngPos  0 Then
strAnfang = Mid(vntArrayWerte(0), 1, lngPos + 6)
vntArrayWerte(0) = Mid(vntArrayWerte(0), lngPos + 6)
'              Debug.Print strAnfang
'              Debug.Print vntArrayWerte(0)
ThisWorkbook.Worksheets("txt.File").Cells(1, 1).Value = strAnfang
End If
strText = vntArrayWerte(UBound(vntArrayWerte))
ReDim Preserve vntArrayWerte(UBound(vntArrayWerte) - 1)
ThisWorkbook.Worksheets("txt.File").Cells(2, 1).Resize( _
UBound(vntArrayWerte) + 1) = Application.Transpose(vntArrayWerte)
lngPos = UBound(vntArrayWerte) + 5
Erase vntArrayWerte
vntArrayWerte = Split(strText, vbCrLf)
'            ThisWorkbook.Worksheets("txt.File").Cells(lngPos, 1).Resize( _
'            UBound(vntArrayWerte) + 1) = Application.Transpose(vntArrayWerte)
' zickt beim zweiten Aufruf aus irgendeinem Grund, also händisch:
For lngFN = 0 To UBound(vntArrayWerte)
If Mid(vntArrayWerte(lngFN), 1, 1)  "=" Then
ThisWorkbook.Worksheets("txt.File").Cells(lngPos + lngFN, 1).Value =  _
vntArrayWerte(lngFN)
Else
ThisWorkbook.Worksheets("txt.File").Cells(lngPos + lngFN, 1).Value = "'" &  _
vntArrayWerte(lngFN)
End If
Next
End If
End With
End Sub
Das Transpose geht deshalb nicht, weil die eine Zeile aus "====" besteht, und was mit "=" anfängt, wird von Excel als Formel interpretiert.
Vielleicht geht das Transpose, wenn Du die Spalte komplett als TEXT formatierst, aber ich mag jetzt nicht groß herumtesten.
Schöne Grüße,
Michael

Anzeige
AW: VBA: Text-Datei nach Excel
21.09.2015 18:37:04
Emre
Hallo Michael,
es funktioniert auch hervorragend ohne dass du testen musst :)
Nur bei einer Sache klappt es nicht so ganz. Der ganze Text bis zum ersten Komma wird in die erste Zeile geschrieben.
Habe gemerkt, dass du das mit den Strichen und Gleichzeichen hier gelöst hast (wenn ichs richtig verstanden habe)
For lngFN = 0 To UBound(vntArrayWerte)
If Mid(vntArrayWerte(lngFN), 1, 1) "=" Then
ThisWorkbook.Worksheets("txt.File").Cells(lngPos + lngFN, 1).Value = _
vntArrayWerte(lngFN)
Else
ThisWorkbook.Worksheets("txt.File").Cells(lngPos + lngFN, 1).Value = "'" & _
vntArrayWerte(lngFN)
End If
Next
Aber ich konnte es nicht für die erste Zeile anwenden.
Gruß
Emre

Anzeige
nee,
22.09.2015 21:13:50
Michael
Emre,
der Knackpunkt liegt in dieser Zeile:
ThisWorkbook.Worksheets("txt.File").Cells(1, 1).Value = strAnfang
Der strAnfang wird aus dem ersten Feld in vntArrayWerte extrahiert, und ich war zu faul, den noch zu bearbeiten, bzw. ich hatte gedacht, das kannst Du vielleicht selbst.
Die "ganz faule" Lösung wäre, die Überschriftenzeilen einfach händisch zu schreiben:
ThisWorkbook.Worksheets("txt.File").Cells(1, 1).Value = "Performanz Analyse:"
ThisWorkbook.Worksheets("txt.File").Cells(2, 1).Value = "'------------------"
ThisWorkbook.Worksheets("txt.File").Cells(3, 1).Value = "blabla"
oder Du mußt halt hier auch einen Split nach vbcrlf machen.
Nochmal das ganze Ding:
Option Explicit
Sub Import_1()
Dim strPfad As String
Dim lngFN As Long, lngPos As Long, zeile As Long
Dim strText As String, strAnfang As String
Dim vntArrayWerte As Variant, a2 As Variant
Dim wksZ As Worksheet
Dim intFileNumber As Integer
zeile = 1
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
With .Filters
If .Count > 0 Then .Clear
Call .Add("Textdateien", "*.txt")
End With
If .Show Then
intFileNumber = FreeFile
Open .SelectedItems(1) For Binary As #intFileNumber
strText = Space(LOF(intFileNumber))
Get #intFileNumber, 1, strText
Close #intFileNumber
vntArrayWerte = Split(strText, ", ")      ' zuerst Komma, dann Leerzeichen
lngPos = InStr(vntArrayWerte(0), "Werte:")
If lngPos  0 Then
strAnfang = Mid(vntArrayWerte(0), 1, lngPos + 6)
vntArrayWerte(0) = Mid(vntArrayWerte(0), lngPos + 6)
'              Debug.Print strAnfang
'              Debug.Print vntArrayWerte(0)
a2 = Split(strAnfang, vbCrLf)
For lngFN = 0 To UBound(a2)
If Mid(a2(lngFN), 1, 1)  "-" Then
ThisWorkbook.Worksheets("txt.File").Cells(zeile, 1).Value = a2(lngFN)
Else
ThisWorkbook.Worksheets("txt.File").Cells(zeile, 1).Value = "'" & a2(lngFN)
End If
zeile = zeile + 1
Next
'              ThisWorkbook.Worksheets("txt.File").Cells(zeile, 1).Value = strAnfang
End If
strText = vntArrayWerte(UBound(vntArrayWerte))
ReDim Preserve vntArrayWerte(UBound(vntArrayWerte) - 1)
ThisWorkbook.Worksheets("txt.File").Cells(zeile, 1).Resize( _
UBound(vntArrayWerte) + 1) = Application.Transpose(vntArrayWerte)
lngPos = UBound(vntArrayWerte) + 5 + zeile
Erase vntArrayWerte
vntArrayWerte = Split(strText, vbCrLf)
'            ThisWorkbook.Worksheets("txt.File").Cells(lngPos, 1).Resize( _
'            UBound(vntArrayWerte) + 1) = Application.Transpose(vntArrayWerte)
' zickt beim zweiten Aufruf aus irgendeinem Grund, also händisch:
For lngFN = 0 To UBound(vntArrayWerte)
If Mid(vntArrayWerte(lngFN), 1, 1)  "=" Then
ThisWorkbook.Worksheets("txt.File").Cells(lngPos + lngFN, 1).Value =  _
vntArrayWerte(lngFN)
Else
ThisWorkbook.Worksheets("txt.File").Cells(lngPos + lngFN, 1).Value = "'" &  _
vntArrayWerte(lngFN)
End If
Next
End If
End With
End Sub
Happy Exceling,
Michael

Anzeige
AW: nee,
23.09.2015 18:59:40
Emre
Hallo Michael,
leider habe ich es nicht hingekriegt. Dann muss man eben die erste Zeile manuell ändern aber trotzdem danke für deine Hilfe :)
Gruß
Emre

verstehe ich nicht,
24.09.2015 15:28:52
Michael
Hi Emre,
ich habe Dir doch den Code geändert, so daß er auch die erste Zeile aufdröselt, und extra komplett MIT Änderungen gepostet, damit Du ihn nur reinkopieren mußt.
Dazu habe ich ein zweites Array a2 verwendet, und der betreffende Code beginnt ab Zeile a2 = Split...
Schöne Grüße,
Michael

AW: verstehe ich nicht,
24.09.2015 18:49:39
Emre
Hallo Michael,
ich weiß und danke nochmal dafür aber es hat nicht geklappt. Ich habs mit dem geänderten Code versucht und dann nochmal separat die "faule Lösung" ging aber nicht.
Vielleicht ist in der Originaldatei etwas anders als beim Beispiel von mir. Aber naja, trotzdem danke für deine Mühe.
Gruß
Emre
Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige