VBA只複製excel中的特定列以導出爲csv

Question

試圖將excel工作表轉換爲僅包含我需要的數據的csv。基本上我只需要導出包含數據的列。我很新使用vba宏。我製作了一個工作表，單元格鏈接到組合框A列AF中的第一行。問題是，當我嘗試直接將工作表保存爲csv或使用下面的宏進行導出時，似乎這些組合框鏈接的單元格會被視爲數據。第一（列標題/變量名）線的 實例，然後一個觀察的例子第一行，我會非常的導出的csv看到：

Author,Year,Yield,Treatment 
Smith,1999,2.6,notill 

在這裏筆者...處理生產線最初來自選擇在鏈接到組合框和史密斯驗證列表限定小區... notill觀察是我在貼的我所看到的，而不是示例：

Author,Year,Yield,Treatment,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
Smith,1999,2.6,notill,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 

其下方則所有觀測行是相同數量的列橫跨。 這會產生問題，因爲如果我在SAS中使用getnames，現在我有了新的變量，這些變量會混淆在一起。我無法指定列，因爲每次創建並導出時都有不同數量的列。如果您需要的列是已知的，則有辦法處理此問題，例如this answer。但是我希望能夠理想地說「只複製非空的列」，或者可以「只複製第一行中具有以下特定文本之一的列」，因爲A2：AF2只能包含如果它們不是空的，那麼32件事中的一件。 這是我得到的代碼，將所有這些空白列複製到一個新的工作簿並保存。

Sub CopyToCSV() 
Dim MyPath As String 
Dim MyFileName As String 
'The path and file names: 
MyPath = "C:\Users\Data\TxY\" 
MyFileName = "TxY_" & Sheets("ValidationHeadings").Range("D3").Value & "_" & Format(Date, "ddmmyy") 
'Makes sure the path name ends with "\": 
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\" 
'Makes sure the filename ends with ".csv" 
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv" 
'Copies the sheet to a new workbook: 
Sheets("TxYdata").Copy 
'The new workbook becomes Activeworkbook: 
With ActiveWorkbook 
'Saves the new workbook to given folder/filename: 

    .SaveAs Filename:= _ 
     MyPath & MyFileName, _ 
     FileFormat:=xlCSV, _ 
     CreateBackup:=False 
'Closes the file 
    .Close False 
End With 
End Sub 

我知道這必須是非常簡單（與沒有在它應該以某種方式脫穎而出列，對吧？），但我昨天搜索了樣4小時如何做到這一點。我寧願不要在每張工作表中以某種方式劃分空列，以便將其變成csv。有什麼我可以添加到

Sheets("TxYdata").Copy 

讓它只複製實際輸入數據的列，當我沒有在每個工作表中一致的列數？或者其他可以完成工作的東西。 非常感謝！

Answer 1

測試這段代碼。

Sub TransToCSV() 

    Dim vDB, vR() As String, vTxt() 
    Dim i As Long, n As Long, j As Integer 
    Dim objStream 
    Dim strTxt As String 
    Dim rngDB As Range, Ws As Worksheet 
    Dim MyPath As String, myFileName As String 
    Dim FullName As String 


    MyPath = "C:\Users\Data\TxY\" 
    myFileName = "TxY_" & Sheets("ValidationHeadings").Range("D3").Value & "_" & Format(Date, "ddmmyy") 
    If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\" 
    If Not Right(myFileName, 4) = ".csv" Then myFileName = myFileName & ".csv" 
    FullName = MyPath & myFileName 

    Set Ws = Sheets("TxYdata") 
    Set objStream = CreateObject("ADODB.Stream") 

    With Ws 
     Set rngDB = .Range("a1", "d" & .Range("a" & Rows.Count).End(xlUp).Row) 
     'Set rngDB = .Range("a1").CurrentRegion <~~ Else use this codle 
    End With 

    vDB = rngDB 
    For i = 1 To UBound(vDB, 1) 
     n = n + 1 
     ReDim vR(1 To UBound(vDB, 2)) 
     For j = 1 To UBound(vDB, 2) 
      vR(j) = vDB(i, j) 
     Next j 
     ReDim Preserve vTxt(1 To n) 
     vTxt(n) = Join(vR, ",") 
    Next i 
    strTxt = Join(vTxt, vbCrLf) 

    With objStream 
     '.Charset = "utf-8" 
     .Open 
     .WriteText strTxt 
     .SaveToFile FullName, 2 
     .Close 
    End With 
    Set objStream = Nothing 

End Sub 

Answer 2

你可以用不同的方式來解決這個問題。這是我會做的。將新工作表添加到工作簿。在你的函數中有一個FOR循環遍歷表單中的所有列。對於每一列，你可以使用這樣的事情，以檢查其是否持有任何數據：

iDataCount = Application.WorksheetFunction.CountIf(<worksheet object>.Range(<your column i.e. `"F:F"`>), "<>" & "") 

如果iDataCount爲0，那麼你知道列是空的。如果它不是0，則將其複製到新表中。完成FOR循環後，將新工作表複製到.csv文件中。最後從你的工作簿中刪除新的工作表（或者你可以把它留在那裏，如果你這樣做，你只需要在下一次運行該過程之前將其清除..也可以通過代碼完成）