Wie erstelle ich Textdateien aus Excel pro Spaltenwert?

Ich bin neu in VBA, ich habe dies manuell gemacht. Ich muss die Erstellung separater Textdateien für jeden Wert in Spalte A automatisieren. Ich möchte, dass die Textdateien mit dem Wert von Spalte A benannt werden, wobei die Spalten BF der Inhalt der Textdateien sind.

Zum Beispiel: Ich habe eine Master-Excel-Datei mit 20000 Zeilen (und 5 Spalten) mit Daten wie den folgenden:

VendorCode | ItemCode | Price1 | Price2 | Price3 
____________________________________________________
033204     | svk3409  | 23.2   | 23.3   | 23.4
_____________________________________________________
033204     | svk5619  | 24.2   | 24.3   | 24.4
_____________________________________________________
033204     | cli7890  | 34.2   | 34.3   | 34.4
_____________________________________________________
023272     | svk3413  | 18.9   | 18.2   | 18.3
_____________________________________________________
023272     | svk4567  | 90.2   |90.3    | 90.4

Ich habe den folgenden Code bisher von Verweisen, aber es gibt nicht alle Zeilen für den jeweiligen Herstellercode zurück. Es wird nur eine Zeile für jede vendorcode.txt zurückgegeben.

Sub SaveRangeToCsvFiles()
    Dim FileName As String
    Dim Ws As Worksheet
    Dim rngDB As Range
    Dim r As Long, c As Long
    Dim pathOut As String
    Dim i As Long

    pathOut = ThisWorkbook.Path & "\" '<~~ set your path:  C:\temp\

    Set Ws = ActiveSheet 'Sheets("AllData")
    With Ws
        r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        'c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        For i = 2 To r
            Set rngDB = .Range("a" & i).Resize(1, 6)
            FileName = .Range("a" & i).Offset(, 4)
            TransToCSV pathOut & FileName & ".txt", rngDB
        Next i
    End With
    MsgBox ("Files Saved Successfully")
End Sub


Sub TransToCSV(myfile As String, rng As Range)
    Dim vDB, vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim objStream
    Dim strTxt As String

    Set objStream = CreateObject("ADODB.Stream")
    vDB = rng
    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR, vbTab)
    Next i
    strTxt = Join(vTxt, vbCrLf)
    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        .Close
    End With
    Set objStream = Nothing
End Sub

Bearbeiten: Ich habe es mit Hilfe einer anderen Ressource versucht und den Code geändert. siehe unten. Jetzt werden alle Zeilen für jeden Herstellercode zurückgegeben. Im Gegensatz zum vorherigen Code werden die Zeilen in den einzelnen Herstellertextdateien nicht überschrieben, sondern angehängt. Das Problem mit diesem Ergebnis ist jedoch, dass sich die Spalten in einer separaten Zeile befinden. Was ich brauche, ist, dass alle Spalten durch Tabulatoren in derselben Zeile getrennt sind. Bitte geben Sie an, wie ich den zweiten Code korrigieren kann. Ich bin sehr nah an dem, was ich erreichen muss.

Sub toFile ()

Dim FilePath As String, CellData As String, LastCol As Long, LastRow As Long
Dim Filenum As Integer, loc As String

LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

'Application.DefaultFilePath = "C:\Users\9418\Desktop\Work Files"
'loc = Application.DefaultFilePath

For i = 1 To LastRow
    FilePath = Application.DefaultFilePath & "\" & Trim(ActiveSheet.Cells(i, 1).Value) & ".txt"
    Filenum = FreeFile

    Open FilePath For Append As Filenum
    CellData = ""

    For j = 2 To LastCol
    CellData = Trim(ActiveSheet.Cells(i, j).Value)
    Print #Filenum, CellData

    Next j

    Close #Filenum

Next i
MsgBox ("Done")

End Sub

** Letzte Änderung: ** Ich poste hier meine eigene Antwort.

Nachdem ich weiter im Internet referenziert hatte, kam ich schließlich auf den folgenden Code, der alle Zeilen pro Herstellercode in separaten Textdateien zurückgibt und die Spaltenwerte ebenfalls in derselben Zeile stehen. Das Problem bei dieser Abfrage besteht nun darin, dass nach der Rückgabe einiger Textdateien ein "Over Flow" -Fehler auftritt, wenn jedoch mehr Zeilen für einen Herstellercode vorhanden sind. Ich habe versucht, die Zeilen in meiner Master-Datei in separate Excel-Dateien aufzuteilen. Jede der Dateien hat 200-500 Zeilen. Trotzdem gibt es mir den Fehler bei Überlauf. Bitte kann jemand vorschlagen, was ich tun kann, um diesen Fehler zu beheben.

Option explizit

Sub CreateFileEachLine ()

Dim myPathTo As String
myPathTo = "\\901db1\IT_Canada\Vending Price Updates"
Dim myFileSystemObject As Object
Set myFileSystemObject = CreateObject("Scripting.FileSystemObject")
Dim fileOut As Object
Dim myFileName As String

Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long

    For i = 2 To lastRow
        If Not IsEmpty(Cells(i, 1)) Then
            myFileName = Cells(i, 1) & ".txt"
            Set fileOut = myFileSystemObject.OpenTextFile(myFileName, 8, True)
            fileOut.write Cells(i, 4) & "   " & Cells(i, 8) & "   " & Cells(i, 8) & "   " & Cells(i, 8) & vbNewLine
            fileOut.Close
        End If
    Next

Set myFileSystemObject = Nothing
Set fileOut = Nothing

End Sub

Sie arbeiten mit einem strukturierten Datensatz. Aus diesem Grund ist der von Ihnen oben angegebene Algorithmus für das, was Sie versuchen, zu kompliziert.

Ein Vorschlag, den ich habe (Pseudocode) ist

Set up path (pathOut) and the correct worksheet
Iterate through each row
  If FileName (Cells(1).Text & ".txt") then open file otherwise create new file
  write/append new data (Cells(2) to Cells(5)). ' Do this simply by using the string value & vbTab rather than a more complicated array function. follow up with vbCrLF
  close file

Das Obige ist einfach, aber sehr ineffizient (eine Dateioperation in jeder Codezeile). Aus Gründen der Effizienz können Sie die Zeilen sortieren, um den Herstellercode zu gruppieren, und die Datei dann für jede Gruppe nur einmal öffnen und schließen. Der Code dafür wird etwas komplexer sein

[...]
  Set the range for the rows in each group
  Open/create the correct file for write/append
    Iterate through each row and write the data
  Close the file
[...]

Für einfache Textdateien, wie Sie sie beschreiben, bevorzuge ich die einfachen Dateivorgänge (siehe zum Beispiel https://www.thespreadsheetguru.com/blog/vba-guide-text-files und https://msdn.microsoft.com/en) -us / vba / sprachreferenz-vba / artikel / open-aussage ) anstatt streams zu benutzen. Unabhängig davon, ob Sie einfache Dateioperationen oder Streams verwenden, kann die String-Manipulation viel einfacher sein, da Sie strukturierte Daten verwenden. Einfacherer Code erleichtert das Debuggen und Überprüfen.