使用Excel宏和VBA创建并写入文本文件 [英] Create and Write to a text file using an excel macro and VBA

问题描述

我正在使用宏和VBA代码创建具有特定格式的文本文件.从宏单元收集创建文本文件所需的所有数据. 我已经附上了宏数据文件和输出文本文件的图片(请参见下文).

I am using a macro and VBA code to create a text file with a specific format. All the data needed to create the text file is gathered from the macro cells. I have attached pictures of the macro data file and the output text file (please see below).

具有数据的Excel宏

所需的输出txt格式示例

此外，下面是我生成的VBA代码，用于从宏获取数据并创建/写入文本文件.我仍然需要弄清楚如何以指定的格式编写它(所需的输出txt格式示例).

Also, below is my VBA code I generated to get data from the macro and create/write into a text file. I still need to figure out how to write it in the specified format (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文件的任何帮助，我们将不胜感激.

Any help with what I need to add in my VBA to create the formatted output txt file will be greatly appreciate it.

谢谢.

推荐答案

您可以将数据组合成一个数组，然后将其转换回文本.

You can combine the data into an array and then convert it back into text.

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创建并写入文本文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！