|
こんにちわ。
ご意見いただいた皆様、
貴重なご意見ありがとうございます。
実際にご教授いただいた通りに記述したのですが、
出力されたCSVは全ての項目が出力してしまいます。
そこで、まる1日かけていろいろ調べたら自分のやりたい
ように出力することができました。
ただ、いろいろな参考プログラムから貼り付けて修正して
作成したのですが、細かくコードの意味などを理解していない
のもございます。
下記に完成したVBAソースを記載致しますので、コメント欄の
間違いやよくわからないものなどをご教授願えたらと思います。
______________VBAコード___________________________________
Private Sub csv_Click()
Dim targetRange As Range, myArea As Range, myColumn As Range
Dim i As Long, j As Long, columnCount As Long
Dim buf As Variant, buf2 As String
Dim FSO As Object
Dim myDir As String
Dim myFname As String
'デスクトップのパス
myDir = CreateObject("WScript.Shell").SpecialFolders("Desktop")
'ファイル名の指定
myFname = myDir & "\" & "TEST.csv"
'ユニオンでA2:A100とE2:E100を抽出
Set FSO = CreateObject("Scripting.FileSystemObject")
Set targetRange = Union(Range("a2:a100"), Range("e2:e100"))
’範囲セルのカウント?
For
Each myArea In targetRange.Areas
columnCount = columnCount + myArea.Columns.Count
Next myArea
'ファイルの出力指定記述
'With FSO.createTextFile("C:\Sample.txt", True) 'overwrite
With FSO.CreateTextFile(myFname, True) 'overwrite
'よくわかりません・・・
For i = 1 To targetRange.Areas(1).Rows.Count
ReDim buf(1 To columnCount)
j = 1
For Each myArea In targetRange.Areas
For Each myColumn In myArea.Columns
buf(j) = myColumn.Cells(i).Text 'Value
j = j + 1
Next myColumn
Next myArea
'A,Eとカンマ区切りで出力
buf2 = Join(buf, ",")
.writeline buf2
Next i
.Close
End With
MsgBox "出力しました"
End Sub
------------------------------------------------------------------------
お時間のあるときご教授下さい。
▼mura さん:
>>下記のコードだとA1〜E100まですべてのデータが出力されてしまいます。
>
>それはそうでしょう。そのようなコードになってますから。
>SaveAsの前に 1行とB列〜D列を削除しましょう。
> Rows(1).Delete
> Columns("B:D").Delete
> .SaveAs myFname, xlCSV
|
|