VBA: Text-Datei nach Excel

Bild

Betrifft: VBA: Text-Datei nach Excel
von: Emre
Geschrieben am: 18.09.2015 18:02:42

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

Bild

Betrifft: AW: VBA: Text-Datei nach Excel
von: Michael
Geschrieben am: 18.09.2015 22:23:53
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

Bild

Betrifft: AW: VBA: Text-Datei nach Excel
von: Emre
Geschrieben am: 19.09.2015 10:43:28
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

Bild

Betrifft: AW: VBA: Text-Datei nach Excel
von: Michael
Geschrieben am: 20.09.2015 17:44:25
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

Bild

Betrifft: AW: VBA: Text-Datei nach Excel
von: Emre
Geschrieben am: 21.09.2015 18:37:04
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

Bild

Betrifft: nee,
von: Michael
Geschrieben am: 22.09.2015 21:13:50
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

Bild

Betrifft: AW: nee,
von: Emre
Geschrieben am: 23.09.2015 18:59:40
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

Bild

Betrifft: verstehe ich nicht,
von: Michael
Geschrieben am: 24.09.2015 15:28:52
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

Bild

Betrifft: AW: verstehe ich nicht,
von: Emre
Geschrieben am: 24.09.2015 18:49:39
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

 Bild

Beiträge aus den Excel-Beispielen zum Thema "VBA: Text-Datei nach Excel"