Bitte um Hilfe bei VBA .txt einlesen!

Moderator: ModerationP

Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon Andreas D. » 06. Okt 2017, 09:31

Ich habe leider nicht viel Ahnung bei VBA, vielleicht kann mir doch jemand helfen!
ich habe diese .txt datei (siehe Anhang) die jeden Montag neu vorliegt. Achtung diese Liste ist im Original viel länger! Die Aufteilung solle jedoch gleich bleiben.
Nun würde ich diese gern einlesen in Excel um sie aus zu werten.
Auswertung nach:KDB-NR.**( ** = unterschiedliche KD-Berater nach Initialien)
Ich benötige nur die Summe-Euro in der vorletzten Spalte und die Durchg. in der letzten Spalte je nach KDB-NR.**
Also änlich wie Beispiel 2 im Anhang: Test.xls
Leider hat die Liste auch immer wieder neue Seiten und eine Trennlinie nach der ich das einlesen gern stoppen möchte. (Da dieser bereich nicht mehr benötigt wird)
Die Trennlinie ist diese: ====================================== (in meiner Vorlage nicht sichtbar)
Danke für Eure Hilfe, Bitte Erklärungen für blutige Anfänger!:-)
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
Andreas D.
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 50
Registriert: 14. Jan 2008, 11:09
Wohnort: BSA

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon 1Matthias » 06. Okt 2017, 21:12

Moin!
Also hier mal eine Variante. Dazu Excel aufmachen und dann in den VB Editor wechseln. (Taste ALT +F11 drücken)
Dort in der linken Spalte Tabelle 1 anklicken. Dann sollte sich mittig ein weißes Fenster aufmachen.
Dahinein den Code kopieren:
Code: Alles auswählen
Option Explicit

Sub txt_einlesen()
Dim ablage As String
Dim fso As Object
Dim inhalt As String
Dim stopper As String
Dim trenner1 As String
Dim trenner2 As String
Dim trenner3 As String
Dim trenner4 As String
Dim trenner5 As String
Dim abschnitte
Dim i As Long
Dim zeile As Long
Dim temp
Dim teil As String
Dim text1 As String


Application.ScreenUpdating = False

'hier deinen Pfad eintragen
ablage = "C:\Users\ich\Desktop\umgebung\Test.txt"

stopper = "====="
trenner1 = "KDB-NR."
trenner2 = "NAME:"
trenner3 = "PERS.-NR."
trenner4 = "ARBEITSPR."
trenner5 = "DURCHG."
text1 = "SUMME-EURO"

zeile = 1

ActiveSheet.Columns("A:J").ClearContents

Set fso = CreateObject("Scripting.Filesystemobject")

inhalt = fso.OpenTextFile(ablage, 1).readall

inhalt = Split(inhalt, stopper)(0)

abschnitte = Split(inhalt, trenner1)

For i = 1 To UBound(abschnitte)
    'KDB
    teil = abschnitte(i)
    temp = Trim(Split(teil, trenner2)(0))
    ActiveSheet.Cells(zeile, 1) = trenner1 & temp

    teil = Trim(Replace(teil, temp, ""))
    temp = Split(teil, trenner3)(0)
    ActiveSheet.Cells(zeile, 2) = Split(temp, ",")(0)
    teil = Trim(Replace(teil, Split(temp, ",")(0), ""))
    temp = Trim(Replace(temp, Split(temp, ",")(0), ""))

    If temp <> "" Then
        ActiveSheet.Cells(zeile, 3) = Trim(Right(temp, Len(temp) - 1))
        teil = Trim(Replace(teil, temp, ""))
    End If
    temp = Split(teil, trenner4)(0)
    ActiveSheet.Cells(zeile, 4) = Trim(temp)
    ActiveSheet.Cells(zeile + 1, 9) = text1
    ActiveSheet.Cells(zeile + 1, 10) = trenner5
   
    teil = Trim(Split(teil, trenner5)(1))
    While InStr(1, teil, "  ", vbTextCompare) > 0
        teil = Trim(Replace(teil, "  ", " "))
    Wend
    temp = Split(teil, vbCrLf)
    ActiveSheet.Cells(zeile + 2, 9) = Split(Trim(temp(1)), " ")(7)
    ActiveSheet.Cells(zeile + 2, 10) = Split(Trim(temp(1)), " ")(8)
    ActiveSheet.Cells(zeile + 3, 9) = Split(Trim(temp(2)), " ")(7)
    ActiveSheet.Cells(zeile + 3, 10) = Split(Trim(temp(2)), " ")(8)
    zeile = zeile + 4

Next i

Application.ScreenUpdating = True
End Sub

In der Zeile mit der Ablage noch deinen Pfad mit Dateinnamen (so wie im Beispiel) eintragen. Danach das Makro ausführen.
Der Code öffnet die Datein im Pfad Ablage. Er liest die DAten aus und trennt sie so, wie in deinem Beispiel. Dabei wird allerdings nicht geprüft ob der Aufbau passt. Bin jetzt mal davon ausgegangen, dass die Datei bzw. die einzelnen Zeilen immer indentisch sind. Es müssen also immer die Felder Name: DKB: PersnNr. etc. exisitieren und die Datenblöcke auch immer 2 zeilig und je 9 Spalten haben.
Einfach mal testen und schauen ob es passt.
VG
1Matthias
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 99
Registriert: 15. Aug 2017, 18:36

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon Andreas D. » 09. Okt 2017, 07:08

Vielen, vielen Dank erstmal. . . .ich habe den Dateinamen angepasst, jetzt kommt Laufzeitfehler(52),Dateiname oder Nummer falsch in dieser Zeile: inhalt = fso.OpenTextFile(ablage, 1).readall
Andreas D.
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 50
Registriert: 14. Jan 2008, 11:09
Wohnort: BSA

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon Andreas D. » 09. Okt 2017, 07:15

Hier mein Code:
Sub txt_einlesen()
Dim ablage As String
Dim fso As Object
Dim inhalt As String
Dim stopper As String
Dim trenner1 As String
Dim trenner2 As String
Dim trenner3 As String
Dim trenner4 As String
Dim trenner5 As String
Dim abschnitte
Dim i As Long
Dim zeile As Long
Dim temp
Dim teil As String
Dim text1 As String


Application.ScreenUpdating = False

'hier deinen Pfad eintragen
ablage = "\C:\Users\drechsler\Downloads\KDB_Liste.txt"

stopper = "====="
trenner1 = "KDB-NR."
trenner2 = "NAME:"
trenner3 = "PERS.-NR."
trenner4 = "ARBEITSPR."
trenner5 = "DURCHG."
text1 = "SUMME-EURO"

zeile = 1

ActiveSheet.Columns("A:J").ClearContents

Set fso = CreateObject("Scripting.Filesystemobject")

inhalt = fso.OpenTextFile(ablage, 1).readall

inhalt = Split(inhalt, stopper)(0)

abschnitte = Split(inhalt, trenner1)

For i = 1 To UBound(abschnitte)
'KDB
teil = abschnitte(i)
temp = Trim(Split(teil, trenner2)(0))
ActiveSheet.Cells(zeile, 1) = trenner1 & temp

teil = Trim(Replace(teil, temp, ""))
temp = Split(teil, trenner3)(0)
ActiveSheet.Cells(zeile, 2) = Split(temp, ",")(0)
teil = Trim(Replace(teil, Split(temp, ",")(0), ""))
temp = Trim(Replace(temp, Split(temp, ",")(0), ""))

If temp <> "" Then
ActiveSheet.Cells(zeile, 3) = Trim(Right(temp, Len(temp) - 1))
teil = Trim(Replace(teil, temp, ""))
End If
temp = Split(teil, trenner4)(0)
ActiveSheet.Cells(zeile, 4) = Trim(temp)
ActiveSheet.Cells(zeile + 1, 9) = text1
ActiveSheet.Cells(zeile + 1, 10) = trenner5

teil = Trim(Split(teil, trenner5)(1))
While InStr(1, teil, " ", vbTextCompare) > 0
teil = Trim(Replace(teil, " ", " "))
Wend
temp = Split(teil, vbCrLf)
ActiveSheet.Cells(zeile + 2, 9) = Split(Trim(temp(1)), " ")(7)
ActiveSheet.Cells(zeile + 2, 10) = Split(Trim(temp(1)), " ")(8)
ActiveSheet.Cells(zeile + 3, 9) = Split(Trim(temp(2)), " ")(7)
ActiveSheet.Cells(zeile + 3, 10) = Split(Trim(temp(2)), " ")(8)
zeile = zeile + 4

Next i

Application.ScreenUpdating = True
End Sub
Andreas D.
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 50
Registriert: 14. Jan 2008, 11:09
Wohnort: BSA

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon snb » 09. Okt 2017, 07:35

Bei mir reicht:

Code: Alles auswählen
Sub M_snb()
  Sheets.Add(, Sheets(Sheets.Count), , "G:\downloads\test.txt").Columns(1).TextToColumns , , , , 0, 0, 0, -1, 0
End Sub
snb
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 5005
Registriert: 25. Sep 2014, 16:37

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon Andreas D. » 09. Okt 2017, 07:56

Danke!!
Mich würde aber der Ansatz vom Matthias schon interessieren :roll:
Andreas D.
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 50
Registriert: 14. Jan 2008, 11:09
Wohnort: BSA

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon Andreas D. » 09. Okt 2017, 10:27

Hallo Matthias, den Eingabefehler von mir habe ich entdeckt ( ablage = "\C:\Users\drechsler\Downloads\KDB_Liste.txt")
, jetzt läuft es endlos bis keine Rückmeldung erfolgt! Was kann ich tun? Danke nochmals
Andreas D.
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 50
Registriert: 14. Jan 2008, 11:09
Wohnort: BSA

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon 1Matthias » 09. Okt 2017, 20:07

Moin!
Also so wie ich das sehe, hast du hier
While InStr(1, teil, " ", vbTextCompare) > 0
teil = Trim(Replace(teil, " ", " "))
Wend

einen Fehler beim Einfügen gemacht (bzw. das System :-) ). Da sollten in der Zeile mit dem while in den Anführungszeichen 2 Leerzeichen sein.
Und beim Replace sollten auch in den ersten Anführungszeichen 2 Leerzeichen sein. Hintergrund ist der, dass deine Datensätze (also die Spalten mit den Nummern) zwischen den Zahlen verschiedene Leerzeichen haben und ich mir nicht sicher war, wie viele. Mit dem Code werden die Leerzeichen auf 1 Leerzeichen verkürzt. Damit kann ich dann einfacher die Zahlen splitten (sollten 9 Zahlenspalten sein).
Der Code sollte also dort so aussehen:
Code: Alles auswählen
While InStr(1, teil, "  ", vbTextCompare) > 0
teil = Trim(Replace(teil, "  ", " "))
Wend

VG
1Matthias
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 99
Registriert: 15. Aug 2017, 18:36

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon Andreas D. » 10. Okt 2017, 06:55

Das geht , das ist ja der Hammer, klasse, genau so hab ich es mir vorgestellt!
Vielen Dank
(Wenn ich Groß bin will ich das auch können) :P
Andreas D.
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 50
Registriert: 14. Jan 2008, 11:09
Wohnort: BSA

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon Andreas D. » 10. Okt 2017, 07:20

Noch eine frage:
ich habe zum Öffnen jetzt oben dies eingefügt:
Code: Alles auswählen
 'ggf. Laufwerk und Ordner als Vorgabe setzen

    ChDir "\"

    ChDrive "c:\"

    'Das Dialogfenster

    Dateiname = Application.GetOpenFilename _
       ("Micrsoft Excel-Dateien (*.xls),*.xls,Textdateien (*.txt),*.txt,")

    If Dateiname = False Then Exit Sub

    MsgBox "Ihre Auswahl:" & vbNewLine & Dateiname

jetzt findet er an dieser Stelle:
Code: Alles auswählen
inhalt = fso.OpenTextFile(ablage, 1).readall

den Inhalt nicht, was muss ich da einsetzten?
Andreas D.
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 50
Registriert: 14. Jan 2008, 11:09
Wohnort: BSA

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon Gast » 10. Okt 2017, 09:56

Moin!
Also zuerst, sollte deine Auswahleinstellung nicht so aussehen?
Code: Alles auswählen
Dateiname = Application.GetOpenFilename _
       ("Micrsoft Excel-Dateien (*.csv),*.csv,Textdateien (*.txt),*.txt,")

Damit kannst du dann ja zwischen csv und txt Dateien wechseln. Alternativ nur die Kürzel, damit sie gleich angezeigt werden. Mit xls Dateien wird der Code wohl nicht fertig werden bzw. in einen Fehler laufen.
Zu deiner eigentlichen Frage:
Bisher war der Pfad ja in der Variablen ablage gespeichert. Nun liest du ihn in Dateiname ein. :-) Da fehlt entweder die Zuordnung von ablage = Dateinname oder du schreibst die Zeile zum Auslesen einfach so:
Code: Alles auswählen
inhalt = fso.OpenTextFile(Dateiname, 1).readall

Damit sollte das dann auch klappen. :-)
VG
Gast
 

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon 1Matthias » 10. Okt 2017, 10:03

Moin nochmal!
NIcht vergessen deine Variable Dateiname zu deklarieren - sonst wirft der Code eine Meldung aus. Das war's jetzt aber.
VG
1Matthias
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 99
Registriert: 15. Aug 2017, 18:36

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon Andreas D. » 10. Okt 2017, 10:58

Danke , ja das war's dann wollte dich auch nicht über strapazieren. . . .Danke
Aber es macht schon spass, mir fehlt nur etliches an VBA wissen! :D
Andreas D.
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 50
Registriert: 14. Jan 2008, 11:09
Wohnort: BSA

Re: Bitte um Hilfe bei VBA .txt einlesen!

Beitragvon 1Matthias » 11. Okt 2017, 13:35

Moin!
Hier mal noch der gänderte Code. Damit wird die Spalte 9 auf Währungsformat gesetzt. Alternativ (falls du es nicht für die ganze Spalte brauchst) habe ich beim EIntragen der Währungen noch zwei auskommentierte Zeilen drin. Damit wäre nur die Zelle als Währung formatiert.
VG
Code: Alles auswählen
Sub txt_einlesen_ohne_Spaltenänderung()
Dim ablage As String
Dim fso As Object
Dim inhalt As String
Dim stopper As String
Dim trenner1 As String
Dim trenner2 As String
Dim trenner3 As String
Dim trenner4 As String
Dim trenner5 As String
Dim abschnitte
Dim i As Long
Dim zeile As Long
Dim temp
Dim teil As String
Dim text1 As String


Application.ScreenUpdating = False

'hier deinen Pfad eintragen
Dateiname = Application.GetOpenFilename _
("Micrsoft Excel-Dateien (*.csv),*.csv,Textdateien (*.txt),*.txt,")

stopper = "====="
trenner1 = "KDB-NR."
trenner2 = "NAME:"
trenner3 = "PERS.-NR."
trenner4 = "ARBEITSPR."
trenner5 = "DURCHG."
text1 = "SUMME-EURO"

zeile = 1

ActiveSheet.Columns("A:J").ClearContents

Set fso = CreateObject("Scripting.Filesystemobject")

inhalt = fso.OpenTextFile(Dateiname, 1).readall

inhalt = Split(inhalt, stopper)(0)

abschnitte = Split(inhalt, trenner1)

' wenn nur die Zellen formatiert werden sollen, das hier raus und unten das rein
ActiveSheet.Columns(9).NumberFormat = "#,##0.00 €"

For i = 1 To UBound(abschnitte)
'KDB
teil = abschnitte(i)
temp = Trim(Split(teil, trenner2)(0))
ActiveSheet.Cells(zeile, 1) = trenner1 & temp

teil = Trim(Replace(teil, temp, ""))
temp = Split(teil, trenner3)(0)
ActiveSheet.Cells(zeile, 2) = Split(temp, ",")(0)
teil = Trim(Replace(teil, Split(temp, ",")(0), ""))
temp = Trim(Replace(temp, Split(temp, ",")(0), ""))

If temp <> "" Then
ActiveSheet.Cells(zeile, 3) = Trim(Right(temp, Len(temp) - 1))
teil = Trim(Replace(teil, temp, ""))
End If
temp = Split(teil, trenner4)(0)
ActiveSheet.Cells(zeile, 4) = Trim(temp)
ActiveSheet.Cells(zeile + 1, 9) = text1
ActiveSheet.Cells(zeile + 1, 10) = trenner5

teil = Trim(Split(teil, trenner5)(1))
While InStr(1, teil, " ", vbTextCompare) > 0
teil = Trim(Replace(teil, " ", " "))
Wend
temp = Split(teil, vbCrLf)
ActiveSheet.Cells(zeile + 2, 9) = cdbl(Split(Trim(temp(1)), " ")(7))
'ActiveSheet.Cells(zeile + 2, 9).NumberFormat = "#,##0.00 €"
ActiveSheet.Cells(zeile + 2, 10) = Split(Trim(temp(1)), " ")(8)
ActiveSheet.Cells(zeile + 3, 9) = cdbl(Split(Trim(temp(2)), " ")(7))
'ActiveSheet.Cells(zeile + 3, 9).NumberFormat = "#,##0.00 €"
ActiveSheet.Cells(zeile + 3, 10) = Split(Trim(temp(2)), " ")(8)
zeile = zeile + 4

Next i

Application.ScreenUpdating = True

End Sub
1Matthias
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 99
Registriert: 15. Aug 2017, 18:36


Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 15 Gäste