Блог

Я хотел бы вывести текстовый файл из некоторых примеров файлов Excel.

Так что я создал следующие образцы.

после открытия текстового файла будут напечатаны все строки.

Но когда я пытаюсь перебирать столбцы , эти значения добавляются в один столбец

Есть ли какой-либо хороший способ создать цикл на основе строк и столбцов ?

В этом текстовом файле используется разделитель запятых.

Спасибо.

  Sub Test_Open()
      Dim strFilePath As String
      Dim ws As Worksheet
      
      
      strFilePath = "C:Userstesttext.txt" 
     
      Workbooks.Open "C:Userstest.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
 

Вы можете добавить некоторую переменную для хранения всей информации о вашем столбце.

Измените свой код

 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 amp; "," amp; ws.Cells(row, column)
Next
' Trim first comma(,)
cols = Mid(cols, 2)
' Write column to one line at last
Print #1, cols
 

Вы можете сохранить его с помощью рабочей книги.Сохраните как *.csv с запросными параметрами

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

Пожалуйста, попробуйте следующий код:

 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:Userstesttext.txt"
     
      Set wb = Workbooks.Open("C:Userstest.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
 

Код не тестируется. Если вы поделитесь файлом, который вы используете, я протестирую его и в конечном итоге что-то оптимизирую, если это так…

Если что-то непонятно, не стесняйтесь обращаться за разъяснениями. Я могу прокомментировать строки, которые кажутся более трудными для понимания.