So erstellen Sie Textdatei aus Excel-Werten

Question

Ich arbeite derzeit an einem Tool, mit dem ich mein spezifisches Profil für Einträge in meiner Excel-Datei erstellen kann.

Unter der Annahme, dass ich diese Werte: Male:

Und ich will unter einer Textdatei wie diese erzeugen. Es muss einen separaten Dateinamen für weibliche und männliche Dateien und nur eine Datei pro Zeile geben.

Im Moment habe ich diesen Code unten:

Sub toFile() 

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

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

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

     Open FilePath For Output As Filenum 
     CellData = "" 

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

     Next j 

     Close #Filenum 

    Next i 
    MsgBox ("Done") 
End Sub 

Beispielausgabe dieses Codes:

Wie kann ich meine erwartete Ausgabe oben genannten erreichen?

Answer 1

Hier ist der endgültige Code, der zwei Dateien erstellen und wird nicht Werte schreiben, wo Zellen sind leer:

Sub toFile() 

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

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

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

     Open FilePath For Output As Filenum 
     CellData = "" 

     For j = 2 To LastCol 
      If Trim(ActiveSheet.Cells(i, j).Value) <> "" Then 
       CellData = Trim(ActiveSheet.Cells(1, j).Value) & ": " & Trim(ActiveSheet.Cells(i, j).Value) 
       Write #Filenum, CellData 
      End If 
     Next j 

     Close #Filenum 

    Next i 
    MsgBox ("Done") 
End Sub 

Answer 2

Verwenden Sie den Code unten Ändern Sie den Code

For i = 2 To LastRow 

und

celldata = Trim(ActiveSheet.Cells(1, j)) & ": " & Trim(ActiveSheet.Cells(i, j).Value)