使用Excelmacros和VBA创build和写入文本文件

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

excelmacros与数据

所需的输出txt格式 – 例如

另外，下面是我生成的VBA代码，用于从macros中获取数据并创build/写入文本文件。 我仍然需要弄清楚如何以指定的格式（如输出txt格式示例）来编写它。

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创build格式化的输出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