Question

我正在使用宏和VBA代码来创建具有特定格式的文本文件。创建文本文件所需的所有数据都是从宏单元格中收集的。我附上了宏数据文件和输出文本文件的图片（请参见下文）。

另外，下面是我生成的VBA代码，用于从宏中获取数据并创建/写入文本文件。我仍然需要弄清楚如何以指定的格式编写它（Desired output txt format-example）。

 Sub ExcelToTxt() 
'Declaring variables 
Dim lCounter As Long 
Dim lLastRow As Long 
Dim destgroup As String 
Dim parmlabel as Variant 
Dim FName As Variant 

'Activate Sheet1 
Sheet1.Activate 

'Find the last row that contains data 
With Sheet1 
    lLastRow = .Cells(.Rows.Count, "A").End(xlDown).Row 
End With

'Create txt file 
FName = Application.GetSaveAsFilename("", "txt file (*.txt), *.txt") 

'Open FName For Output As #1
For lCounter = 2 To lLastRow 
    'Read specific data from the worksheet 
    With Sheet1 destgroup = .Cells(lCounter, 19) 
        parmlabel = .Cells(lCounter, 8) 
        If destgroup="trex_15hz" Or destgroup="trex_10hz" Or destgroup="trex_5hz" Then 
            'Write selected data to text file 
            'Write #1, parmlabel 
        End If
    End With
'Continue looping until the last row 
Next lCounter 

'Close the text file 
Close #1 

End Sub

任何有关我需要在VBA中添加以创建格式化输出txt文件的帮助都将非常感激。

提前谢谢。

Answer 1

您可以将数据合并到一个数组中，然后将其转换回文本。

Sub ExcelToTxt()
'Declaring variables
    Dim i As Long, j As Integer
    Dim n As Long, k As Long
    Dim destgroup As String
    Dim FName As String
    Dim vDB, vR(1 To 6), vJoin(), vResult()
    Dim sJoin As String, sResult As String
    Dim s As Long
    'Activate Sheet1
    Sheet1.Activate

    'Find the last row that contains data
    With Sheet1
        vDB = .Range("a1").CurrentRegion '<~~ get data to array from your data range
        n = UBound(vDB, 1) 'size of array (row of 2 dimension array)
    End With

    'Create txt file
    FName = Application.GetSaveAsFilename("", "txt file (*.txt), *.txt")

    For i = 2 To n '<~~loop
            destgroup = vDB(i, 2) '<~~ second column
            If destgroup = "trex_15hz" Or destgroup = "trex_10hz" Or destgroup = "trex_5hz" Then

                vR(1) = "; ### LABEL DEFINITION ###" '<~~ text 1st line
                s = Val(Replace(vDB(i, 3), "label", ""))
                vR(2) = "EQ_LABEL_DEF,02," & Format(s, "000")
                vR(3) = "UDB_LABEL," & Chr(34) & vDB(i, 4) & Chr(34) '<~~ 2nd line

                    ReDim vJoin(4 To 7)
                    vJoin(4) = Chr(34) & vDB(i, 4) & Chr(34)
                    For j = 5 To 7
                        vJoin(j) = vDB(i, j)
                    Next j
                    sJoin = Join(vJoin, ",")

                vR(4) = "STD_SUB_LABE," & sJoin '<~~ 3th line

                    ReDim vJoin(8 To 12)
                    vJoin(8) = Chr(34) & UCase(vDB(i, 8)) & Chr(34)
                    vJoin(9) = Chr(34) & vDB(i, 9) & Chr(34)
                    vJoin(10) = Format(vDB(i, 10), "#.000000000")
                    For j = 11 To 12
                        vJoin(j) = vDB(i, j)
                    Next j
                    sJoin = Join(vJoin, ",")

                vR(5) = "STD_SUB_LABE," & sJoin '<~~ 4the line
                vR(6) = "END_EQ_LABEL_DEF"  '<~~ 5th line
                k = k + 1
                ReDim Preserve vResult(1 To k)
                vResult(k) = Join(vR, vbCrLf) '<~~ 5 line in array vR and get to array vResult with join method
            End If
    Next i
    sResult = "EQUIPMENT_ID_DEF,02,0x1," & Chr(34) & "trex" & Chr(34) '<~~ text file first line
    sResult = sResult & vbCrLf & Join(vResult, vbCrLf) '<~~ combine 1th and other line

    ConvertText FName, sResult '<~~ sub presedure
End Sub
Sub ConvertText(myfile As String, strTxt As String)
    Dim objStream

    Set objStream = CreateObject("ADODB.Stream")
    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

使用excel宏和VBA创建和写入文本文件

1 个答案: