2017-08-04 9 views
1

として、必要なデータのみでCSVに変換しようとしました。基本的には、データを含む列のみをエクスポートする必要があります。私はvbaマクロを使うのが初めてです。私は列A:AFの最初の行のコンボボックスにリンクされたセルを含むワークシートを作成しました。問題は、これらのコンボボックスにリンクされたセルが、ワークシートをCSV形式で直接保存しようとしたとき、または以下のマクロを使用してエクスポートするときに、データとして扱われるようです。VBAでExcelの特定の列だけをコピーして、エクスポートするワークシートをcsv

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

著者...処理ラインはもともと選択肢どこから来たのか:最初の(列見出し/変数名)ラインと、私は理想的にエクスポートされたCSVで見ることが1回の観察の後、例の最初の行の 例。コンボボックスとスミスにリンクされている検証リスト制限された細胞では... notill観察は、私が代わりに何を参照してくださいの例では、私は貼り付けるものです:

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

そして同じ数のあるその下の観測値のすべての行列を横切る。 これは、SASでgetnamesを実行すると、マージアップを行う新しい変数が追加されているので、問題が発生します。列を指定することはできません。なぜなら、この列を作成してエクスポートするたびに、列の数が異なるからです。たとえば、this answerなど、必要な列がわかっている場合は、これに対処する方法があります。しかし、理想的には「空でない列だけをコピーする」、あるいは「最初の行に次の特定のテキストの列だけをコピーする」と言うことができるようにしたいと考えています.A2には、彼らが空でないなら32のうちの1つ。 ここでは、これらの空白の列をすべて新しいブックにコピーして保存するコードを示します。

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 

に追加することができるものはありますか?仕事を終わらせる何か他のもの。 ありがとう!

答えて

0

テストこのコード。

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 
+0

私は 'Set rngDB = .Range(" a1 ")。CurrentRegion'を使って作業しました。 Set rngDB = .Range( "a1"、 "d"&.Range( "a"&Rows.Count).End(xlUp).Row) 'は列a:dに対して機能します。ありがとう! – Anomie

0

これはさまざまな方法でアプローチできます。ここに私がすることがあります。ブックに新しいシートを追加します。関数内のFORループをシートのすべての列を通過させます。列ごとに、あなたはそれがどのようなデータを保持しているかどうかを確認するために、このようなものを使用することができます:0である

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

iDataCountなら、あなたは列が空である知っています。 0以外の場合は、新しいシートにコピーします。 FORループを完了したら、新しいシートを.csvファイルにコピーします。最後に、新しいブックをブックから削除してください(または、そのままにしておくと、次回にプロセスを実行する前にクリアする必要があります)。

関連する問題