VBA: Экспортировать более одного столбца в txt

Question

Я пытаюсь экспортировать несколько столбцов данных в excel - с пустыми ячейками в них - до одного - без пробелов - в .txt-файл. До сих пор я собрал несколько фрагментов кода, и я могу успешно экспортировать ОДИН столбец. Что я надеюсь сделать, это скопировать/вставить один столбец ниже одного и так далее в .txt без пробелов.

Private Sub CommandButton2_Click() 
Dim r As Range, c As Range, rng As Range 
Dim sTemp As String 
Dim UnusedColumn As Range 
Dim Filename As String 

Filename = ActiveWorkbook.Path & "\xxx.txt" 
Open Filename For Output As #1 
Set rng = Range("A2:A1000") 

'Find a column with nothing in it 
    Set UnusedColumn = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).EntireColumn.Offset(0, 15) 

'Create temporary calculation column to determine which cells to select (marked by an X) 
    Intersect(rng.EntireRow, UnusedColumn) = Evaluate("IF(" & rng.Address & "="""","""",""X"")") 

'Make Selection 
    Intersect(UnusedColumn.SpecialCells(xlConstants).EntireRow, rng.EntireColumn).Select 

'Remove Temporary Blank Caluclations 
    UnusedColumn.Clear 

For Each r In Selection 
    sTemp = "" 
    For Each c In r.Cells 
     sTemp = sTemp & c.Text & Chr(9) 
    Next c 

    'Get rid of trailing tabs 
    While Right(sTemp, 1) = Chr(9) 
     sTemp = Left(sTemp, Len(sTemp) - 1) 
    Wend 
    Print #1, sTemp 
Next r 
Close #1 
End Sub 

Есть несколько инструкций для автоматического выбора непустых ячеек и для экспорта каждой строки без кавычек.

Вот как .txt выглядит как с исходным кодом (один столбец): http://i.stack.imgur.com/DiB33.jpg

А вот как столбцы выглядеть следующим образом: http://i.stack.imgur.com/9Tn3m.jpg

Извините за необработанного английский и код. Спасибо заранее!

Answer 1

Когда вы перебираете массив с помощью For Each Loop, VBA выполняет итерацию каждого элемента по столбцам (все элементы в 1-м столбце, затем все элементы во втором столбце ... и т. Д.).

потребовалось 2,38 секунды, чтобы написать 10000 строк х 255 столбцов с 50% населенной с номерами 14 значного хранится в виде текста

Sub WriteToValues() 
    Dim Start: Start = Timer 
    Dim Data, v 
    Dim FileName As String 
    FileName = ActiveWorkbook.Path & "\xxx.txt" 

    Data = ActiveSheet.UsedRange.Value2 

    Open FileName For Output As #1 

    For Each v In Data 
     If v <> vbNullString Then Print #1, CStr(v) 
    Next 

    Close #1 
    Debug.Print Timer - Start 
End Sub