Inhalt aus Zellen in eine Textdateien mit Endung .dat schreibe

  • Excel

Es gibt 9 Antworten in diesem Thema. Der letzte Beitrag () ist von petaod.

    Inhalt aus Zellen in eine Textdateien mit Endung .dat schreibe

    Hallo ihr VBA Experten,

    ich bin neu im Forum, und auch ein Neuling in VBA.
    Bisher habe ich es aber immer geschafft aus Codeschnipseln für mich den richtigen VBA Code zusammenzufügen, leider bin ich jetzt mit meiner Methode am Ende und erhoffe mir von Euch Hilfe.

    Folgendes Problem habe ich:

    Ich habe eine Exceldatei (nur ein sheet), die hat in den Spalten A und B (wobei A1 und B1 sind Überschriften) einen bestimmten Textinhalt. Wobei die Länge des Strings in A und B unterschiedlich lang sein kann.
    Beispiel:

    A2: ABCDE123456 B2: 11-XX-YY-AABB
    A3: ABCDE234567 B2: 11-XY-YX-ABAB-CD
    .
    .
    Ai
    usw.

    Die Länge (i) Spalten kann unterschiedlich sein.

    Ich möchte nun den Inhalt jeder Zeile in eine Datei schreiben mit der Endung .dat. Der Name der Datei steht dabei in Spalte A. Der Zielordner ist fest definiert.

    Der Inhalt der erzeugten Dateien sollte Folgender sein

    "Ai" TabStop "Bi"

    in meinem Beispiel oben, sollten also 2 Dateien erzeugt werden:

    Datei1:
    Dateiname: ABCDE123456.dat
    Inhalt: ABCDE123456[TabStop]11-XX-YY-AABB

    Datei2:
    Dateiname: ABCDE234567.dat
    Inhalt: ABCDE234567[TabStop]11-XY-YX-ABAB-CD


    Vielen Dank im voraus für eure Hilfe.

    Viele Grüße

    Norbert

    Willkommen im Forum.

    Mein angestaubtes VBA-Wissen auskramend:
    Alle Zeilen durchgehen: Do-Loop mit Kontrolle des Cells-Value in Spalte 1, bis in jener Value eben leer ist
    in eine Datei schreiben: mit Open, Print, Close

    Fertigen Code kann man damit erzeugen, hab ich selbst gerade erfolgreich getestet. Da das Forum aber zum Lernen ist, nicht zum Codeabgreifen, versuche bitte, den Rest selber hinzubekommen. Es sind (bei mir) nur 13 Zeilen.
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Ich habe auch nur angestaubtes VBA Wissen, aber schwer ist das alles nicht.
    Wie immer muss man die Anforderung nur in kleine Happen aufteilen.
    Was du zum Beispiel wissen musst, ist sicher die Range, das heißt die letzte Zeile vor allem, die letzte Spalte ist dir ja bekannt.
    Dazu werfe ich diese Seite mal in den Raum: excel-inside.de/vba-loesungen/…e-zelle-per-vba-ermitteln

    in meinem Beispiel oben, sollten also 2 Dateien erzeugt werden:


    Visual Basic-Quellcode

    1. ’Datei1:
    2. Open “ABCDE123456.dat” For output as #1
    3. Print #1, “ABCDE123456”; Chr$(9); “11-XX-YY-AABB”
    4. close
    6. ’Datei2:
    7. Open “ABCDE234567.dat” for Output as #1
    8. Print #1, “ABCDE234567”; VbTab; “11-XY-YX-ABAB-CD”
    9. Close
    ;( :D

    So habe nen code geschrieben, es werden aber keine Dateien erzeugt. Irgendein Problem mit dem Do-Loop.

    Angefangen habe ich mit dem Code indem ich ohne Loop für die ersten 2 Zeilen mit der open und print funktion, direkt auf Zellbezüge über Range("A2") usw zugegriffen habe und die dann in eine datei geschrieben habe.

    Das hat soweit funktioniert, aber dieser Code war ja nicht dynamisch. D.h. ich hätte das für eine feste Anzahl von Zellen machen können.

    Hier mein Code mit Do schleife:

    Visual Basic-Quellcode

    1. Sub Seriennummerndatei_erzeugen()
    2. Dim letztezeile As Long
    3. Dim Dateiname As String
    4. Dim SrNr As String
    5. Dim ArtNr As String
    6. Dim i As Long
    7. Dim n As Long
    8. Dim counter As Long
    9. counter = 0
    11. letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    12. MsgBox letztezeile
    13. i = 2
    14. Do While i = letztezeile
    15. 'MsgBox Dateiname
    16. SrNr = ActiveSheet.Cells(i, 1).Value
    17. Dateiname = SrNr & ".dat"
    18. ArtNr = ActiveSheet.Cells(i, 2).Value
    19. 'MsgBox ArtNr
    20. Open "C:\Temp\" & Dateiname For Output As #n
    21. Print #n, SrNr; Chr$(9); ArtNr
    22. counter = counter + 1
    23. i = i + 1
    24. MsgBox i
    25. Close
    26. Loop
    27. MsgBox counter & " Seriennummerndateien wurden erzeugt"
    28. End Sub


    CodeTags gesetzt ~VaporiZed

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()

    Nor schrieb:

    Do While i = letztezeile
    Du kommst nie in die Schleife rein, weil letzteZeile vermutlich <> 2 ist ;)
    Wenn, dann wäre eine Do Until vielleicht zielführend.
    Aber versuch's besser mit einer For-Schleife anstatt einer Do.

    Visual Basic-Quellcode

    1. For i = 2 to letzteZeile
    2. ...
    3. Next

    Mach dann aber das i = i + 1 aus der Schleife raus. For inkrementiert selbst.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    So, vielen Dank für eure Hilfe.

    habs doch mit Do-loop hinbekommen. Der Fehler war wie petaod vermutete, dass mit while i=letztezeile ich gar nicht in den Loop kam.

    funktionieren tut es mit while i<letztezeile

    Visual Basic-Quellcode

    1. Sub Seriennummerndatei_erzeugen()
    2. Dim letztezeile As Long
    3. Dim Dateiname As String
    4. Dim SrNr As String
    5. Dim ArtNr As String
    6. Dim i As Long
    7. Dim n As Long
    8. Dim counter As Long
    9. counter = 0
    11. letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    12. 'MsgBox letztezeile
    13. i = 3
    14. n = FreeFile
    15. Do While i < letztezeile + 1
    16. 'MsgBox Dateiname
    17. SrNr = ActiveSheet.Cells(i, 1).Value
    18. Dateiname = SrNr & ".dat"
    19. ArtNr = ActiveSheet.Cells(i, 2).Value
    20. 'MsgBox ArtNr
    21. Open "C:\Temp\" & Dateiname For Output As #n
    22. Print #n, SrNr; Chr$(9); ArtNr
    23. counter = counter + 1
    24. i = i + 1
    25. Close
    26. Loop
    27. MsgBox counter & " Seriennummerndateien wurden erzeugt"
    28. If letztezeile > 2 Then
    29. Range(Cells(3, 1), Cells(letztezeile, 2)).Select
    30. Selection.ClearContents
    31. Else
    32. End If
    34. End Sub

Facebook
Telefonspende