如何通过excel VBA中的列循环

Question

我想从一些示例 excel 文件中输出文本文件。

所以我创建了以下示例。

打开文本文件后，打印每一行。

但是当我尝试遍历列时，这些值被附加在一列中

有没有什么好的方法可以实现基于行列的循环？

此文本文件使用逗号分隔符。

谢谢。

 Sub Test_Open()
      Dim strFilePath As String
      Dim ws As Worksheet
      
      
      strFilePath = "C:\Users\test\text.txt" 
     
      Workbooks.Open "C:\Users\test.xlsx"
        
      Set ws = ActiveWorkbook.Worksheets("test")
      
      Open strFilePath For Output As #1
      
        Dim row As Integer
        Dim column As Integer
        
        row = 7
        Do Until ws.Cells(row, 2).Value = ""
           For column = 1 To 86
                Print #1, ws.Cells(row, column)
           Next
           row = row + 1
        Loop

      Close #1
     
    End Sub

Answer 1

您可以添加一些变量来保存所有列信息。

更改您的代码

For column = 1 To 86
    Print #1, ws.Cells(row, column)
Next

到此代码。

Dim cols As String
' Add all column separated by comma(,)
For column = 1 To 86
    cols = cols & "," & ws.Cells(row, column)
Next
' Trim first comma(,)
cols = Mid(cols, 2)
' Write column to one line at last
Print #1, cols

Answer 2

您可以使用 Workbook.SaveAs 将其保存为带有所需选项的 *.csv

Sub Test_Open()
    Dim strFilePath As String
    strFilePath = "c:\test\text.txt"
    
    With Workbooks.Open("c:\test\test.xlsx").Worksheets("test")
        .SaveAs strFilePath, xlCSV
        .Parent.Close False
    End With
End Sub

Answer 3

请尝试下一个代码：

Sub Test_Open()
      Dim strFilePath As String, wb As Workbook, ws As Worksheet
      Dim i As Long, j As Long, txtArr, colArr, nrCol As Long, arrFin
      
      strFilePath = "C:\Users\test\text.txt"
     
      Set wb = Workbooks.Open("C:\Users\test.xlsx")
      Set ws = wb.Worksheets("test")
      txtArr = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(strFilePath, 1).ReadAll, vbCrLf)
      nrCol = UBound(Split(txtArr(0), ","))
      ReDim arrFin(1 To UBound(txtArr) - 6, 1 To nrCol)
      For i = 6 To UBound(txtArr)
            colArr = Split(txtArr(i), ",")
            For j = 0 To nrCol
                arrFin(i + 1, j + 1) = colArr(j)
            Next j
      Next
      ws.Range("A1").Resize(UBound(arrFin), UBound(arrFin, 2)).value = arrFin
End Sub

代码未经测试。如果你愿意分享你使用的文件，我会测试它并最终优化一些东西，如果是这样的话......

如果有不清楚的地方，请随时要求澄清。我可以评论那些看起来更难理解的行。