ExcelのマクロとVBAを使用してテキストファイルを作成して書き込む

Question

マクロとVBAコードを使用して特定の形式のテキストファイルを作成しています。テキストファイルの作成に必要なすべてのデータは、マクロセルから収集されます。 マクロデータファイルと出力テキストファイルの写真が添付されています（下記参照）。

excel macro with data

Desired output txt format-example

また、以下の私のVBAコードは、私がマクロからデータを取得し、作成/テキストファイルに書き込むために生成されます。私はまだ指定されたフォーマット（望ましい出力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 

フォーマットされた出力txtファイルを作成するために私のVBAに追加する必要があるものは、大いに感謝します。

ありがとうございます。

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