2016-09-25 55 views
1

我试图导出excel中的数据列中的空白单元格 - 将单个单元格 - 没有空格 - 导入到.txt文件中。 到目前为止,我已经汇编了一些代码段,并且可以导出一列成功。 我希望做的是复制/粘贴之前的一列下一列到.txt没有空白。VBA:将多个列导出到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

对不起,未抛光的英文和代码。 在此先感谢!

回答

0

当您使用For Each Loop遍历数组时,VBA按列(第1列中的所有元素,第2列中的所有元素等)迭代每个元素。

花了2.38其次写10,000行X 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 

enter image description here

+0

这是伟大的,托马斯!介意我问另一个问题?假设我想拥有A2:D1000范围......我该如何解决这个问题? 谢谢! – NameLess

+0

继续。射击 – 2016-09-26 01:25:23

+0

让我说我想有一个A2:D1000范围......我该如何解决这个问题?谢谢! – NameLess