Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2763 / 13645 ツリー ←次へ | 前へ→

【66068】範囲指定のCSV出力について VBA初心者 10/7/23(金) 17:25 質問[未読]
【66070】Re:範囲指定のCSV出力について neptune 10/7/23(金) 18:06 発言[未読]
【66079】Re:範囲指定のCSV出力について mura 10/7/25(日) 14:10 回答[未読]
【66083】Re:範囲指定のCSV出力について VBA初心者 10/7/26(月) 15:39 質問[未読]
【66084】Re:範囲指定のCSV出力について mura 10/7/26(月) 16:09 回答[未読]
【66085】Re:範囲指定のCSV出力について VBA初心者 10/7/26(月) 16:22 お礼[未読]
【66086】Re:範囲指定のCSV出力について mura 10/7/26(月) 16:33 回答[未読]
【66090】Re:範囲指定のCSV出力について VBA初心者 10/7/27(火) 9:33 質問[未読]
【66093】Re:範囲指定のCSV出力について mura 10/7/27(火) 12:06 回答[未読]
【66087】Re:範囲指定のCSV出力について teian 10/7/26(月) 19:26 発言[未読]
【66089】Re:範囲指定のCSV出力について VBA初心者 10/7/27(火) 9:16 質問[未読]
【66091】Re:範囲指定のCSV出力について teian 10/7/27(火) 9:55 回答[未読]
【66092】Re:範囲指定のCSV出力について VBA初心者 10/7/27(火) 10:30 お礼[未読]
【66110】Re:範囲指定のCSV出力について kanabun 10/7/31(土) 0:30 発言[未読]

【66068】範囲指定のCSV出力について
質問  VBA初心者  - 10/7/23(金) 17:25 -

引用なし
パスワード
   VBA初心者です。

Excelにて
A1〜E100までデータが記載してあり、下記のコード
を実行してA2〜A100までとE2〜E100までの2列のデータ
のみをTEST.csvとして出力しようとしております。
(出力CSVファイルのA列にA2〜A100、B列にB2〜B100を出力する)
下記のコードだとA1〜E100まですべてのデータが出力されてしまいます。

 出力セルの範囲を指定してCSV形式で出力する仕方をご教授して
いただきたく書込みしました。

いくつか試したパターンは
With 〜 End Withまでに
Range("A2:A20,E2:E20").Select
Worksheets("sheet1").Range("A2:A20,E2:E20").Copyなど
いくつか思いつく命令を記載しましたが、「〜メソッドが失敗しました」
と表示されてしまいます。


お時間のある時ご教授をお願い致します。


_________________ソースコード__________________________________________

Private Sub csv_Click()

Dim myDir As String
Dim myFname As String

'デスクトップのパス
myDir = CreateObject("WScript.Shell").SpecialFolders("Desktop")
myFname = myDir & "\" & "TEST.csv"


'新規Bookにアクティブシートをコピー
ActiveSheet.Copy

'CSV形式で保存
With ActiveWorkbook
   .SaveAs myFname, xlCSV
   .Close False
End With
MsgBox "出力しました"


End Sub

________________________________________________________________________

【66070】Re:範囲指定のCSV出力について
発言  neptune  - 10/7/23(金) 18:06 -

引用なし
パスワード
   ▼VBA初心者 さん:
「csv 選択範囲 保存」で過去ログを検索してみて下さい。
そのまんま使えるのが有りそう?
 理解してからテストして下さい。

【66079】Re:範囲指定のCSV出力について
回答  mura  - 10/7/25(日) 14:10 -

引用なし
パスワード
   >下記のコードだとA1〜E100まですべてのデータが出力されてしまいます。

それはそうでしょう。そのようなコードになってますから。
SaveAsの前に 1行とB列〜D列を削除しましょう。
 Rows(1).Delete
 Columns("B:D").Delete
 .SaveAs myFname, xlCSV

【66083】Re:範囲指定のCSV出力について
質問  VBA初心者  - 10/7/26(月) 15:39 -

引用なし
パスワード
   こんにちわ。
ご意見いただいた皆様、
貴重なご意見ありがとうございます。

実際にご教授いただいた通りに記述したのですが、
出力された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

【66084】Re:範囲指定のCSV出力について
回答  mura  - 10/7/26(月) 16:09 -

引用なし
パスワード
   >お時間のあるときご教授下さい。
>▼mura さん:
>>>下記のコードだとA1〜E100まですべてのデータが出力されてしまいます。
>>
>>それはそうでしょう。そのようなコードになってますから。
>>SaveAsの前に 1行とB列〜D列を削除しましょう。
>> Rows(1).Delete
>> Columns("B:D").Delete
>> .SaveAs myFname, xlCSV

既に、SaveAsの前に 1行とB列〜D列を削除 と答えの1つを示していますが...
Private Sub csv_Click()
 Dim fname$
 fname = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\test.csv"
 Application.ScreenUpdating = False
 ActiveSheet.Copy
 Rows(1).Delete
 Columns("B:D").Delete
 If Dir(fname) <> "" Then Kill fname
 With ActiveWorkbook
  .SaveAs fname, xlCSV
  .Close False
 End With
 Application.ScreenUpdating = True
 MsgBox "出力しました"
End Sub

【66085】Re:範囲指定のCSV出力について
お礼  VBA初心者  - 10/7/26(月) 16:22 -

引用なし
パスワード
   ご返信ありがとうございます。
>>>SaveAsの前に 1行とB列〜D列を削除しましょう。
記述が足りなく申し訳ないです。
B列〜D列の文字を合わせてE列を作成
している為(text関数)、削除するとE列がエラーに
なってしまいます。

以上、よろしくお願い致します。

▼mura さん:
>>お時間のあるときご教授下さい。
>>▼mura さん:
>>>>下記のコードだとA1〜E100まですべてのデータが出力されてしまいます。
>>>
>>>それはそうでしょう。そのようなコードになってますから。
>>>SaveAsの前に 1行とB列〜D列を削除しましょう。
>>> Rows(1).Delete
>>> Columns("B:D").Delete
>>> .SaveAs myFname, xlCSV
>
>既に、SaveAsの前に 1行とB列〜D列を削除 と答えの1つを示していますが...
>Private Sub csv_Click()
> Dim fname$
> fname = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\test.csv"
> Application.ScreenUpdating = False
> ActiveSheet.Copy
> Rows(1).Delete
> Columns("B:D").Delete
> If Dir(fname) <> "" Then Kill fname
> With ActiveWorkbook
>  .SaveAs fname, xlCSV
>  .Close False
> End With
> Application.ScreenUpdating = True
> MsgBox "出力しました"
>End Sub

【66086】Re:範囲指定のCSV出力について
回答  mura  - 10/7/26(月) 16:33 -

引用なし
パスワード
   >記述が足りなく申し訳ないです。
>B列〜D列の文字を合わせてE列を作成
>している為(text関数)、削除するとE列がエラーに
>なってしまいます。

だったら、
 ActiveSheet.Copy の次行に
 ↓を入れるとか...
 ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

【66087】Re:範囲指定のCSV出力について
発言  teian  - 10/7/26(月) 19:26 -

引用なし
パスワード
   別案です。

1.B〜D列を一時的に非表示
2.A2:E100の範囲をクリップボードへCopy
3.クリップボードから取り出し
4.B〜D列を再表示
5.クリップボードから取り出したテキスト上の
タブ区切りをカンマ区切りに置換して、
ファイル出力
といった手順ではいかがでしょう。


'Microsoft Forms 2.0 Object Library を参照設定
(手動での参照設定が面倒なら一時的にユーザーフォームを追加→解放でも可)
Sub Sample()
Dim myDir As String
Dim myFname As String
Dim buf As String
Dim fn As Integer

'デスクトップのパス
myDir = CreateObject("WScript.Shell").SpecialFolders("Desktop")
'ファイル名の指定
myFname = myDir & "\" & "TEST.csv"
With Worksheets(1)
  .Columns("B:D").Hidden = True
  .Range("A2:E100").Copy
  With New DataObject
    .GetFromClipboard
    buf = .GetText
    Application.CutCopyMode = False
  End With
  .Columns("B:D").Hidden = False
End With

fn = FreeFile()
Open myFname For Output As #fn
Print #fn, Replace(buf, vbTab, ",");
Close #fn
End Sub

【66089】Re:範囲指定のCSV出力について
質問  VBA初心者  - 10/7/27(火) 9:16 -

引用なし
パスワード
   ありがとうございます。
ご教授いただいた内容でもテストして成功しました。
一つご質問がございます。
Open myFname For Output As #fnや
Print #fnやClose #fnの#fnはどのような意味でしょうか。

よろしくお願い致します。

▼teian さん:
>別案です。
>
>1.B〜D列を一時的に非表示
>2.A2:E100の範囲をクリップボードへCopy
>3.クリップボードから取り出し
>4.B〜D列を再表示
>5.クリップボードから取り出したテキスト上の
> タブ区切りをカンマ区切りに置換して、
> ファイル出力
>といった手順ではいかがでしょう。
>
>
>'Microsoft Forms 2.0 Object Library を参照設定
>(手動での参照設定が面倒なら一時的にユーザーフォームを追加→解放でも可)
>Sub Sample()
>Dim myDir As String
>Dim myFname As String
>Dim buf As String
>Dim fn As Integer
>
>'デスクトップのパス
>myDir = CreateObject("WScript.Shell").SpecialFolders("Desktop")
>'ファイル名の指定
>myFname = myDir & "\" & "TEST.csv"
>With Worksheets(1)
>  .Columns("B:D").Hidden = True
>  .Range("A2:E100").Copy
>  With New DataObject
>    .GetFromClipboard
>    buf = .GetText
>    Application.CutCopyMode = False
>  End With
>  .Columns("B:D").Hidden = False
>End With
>
>fn = FreeFile()
>Open myFname For Output As #fn
>Print #fn, Replace(buf, vbTab, ",");
>Close #fn
>End Sub

【66090】Re:範囲指定のCSV出力について
質問  VBA初心者  - 10/7/27(火) 9:33 -

引用なし
パスワード
   ありがとうございます。

ご教授、有難うございます。
 ご教授いただいたように試したのですが、出力したCSVが全項目出力
され、BCDのシートが削除されEシートの項目でエラーが起きてしまいます。

よろしくお願い致します。

________________________VBAソース_________________________________________
Private Sub csv_Click()
 Dim fname$
 fname = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\TEST.csv"
 Application.ScreenUpdating = False
 ActiveSheet.Copy
 ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
 Rows(1).Delete
 Columns("B:D").Delete
 If Dir(fname) <> "" Then Kill fname
 With ActiveWorkbook
  .SaveAs fname, xlCSV
  .Close False
 End With
 Application.ScreenUpdating = True
 MsgBox "出力しました"
End Sub


▼mura さん:
>>記述が足りなく申し訳ないです。
>>B列〜D列の文字を合わせてE列を作成
>>している為(text関数)、削除するとE列がエラーに
>>なってしまいます。
>
>だったら、
> ActiveSheet.Copy の次行に
> ↓を入れるとか...
> ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

【66091】Re:範囲指定のCSV出力について
回答  teian  - 10/7/27(火) 9:55 -

引用なし
パスワード
   ▼VBA初心者 さん:
>ありがとうございます。
>ご教授いただいた内容でもテストして成功しました。
>一つご質問がございます。
>Open myFname For Output As #fnや
>Print #fnやClose #fnの#fnはどのような意味でしょうか。
>
>よろしくお願い致します。
>
OpenステートメントのHelpをご確認下さい。

【66092】Re:範囲指定のCSV出力について
お礼  VBA初心者  - 10/7/27(火) 10:30 -

引用なし
パスワード
   ありがとうございます。

テキストファイルの読み込み、書き込みの操作

●Open ファイルを開く
●FreeFile 使用可能なファイル番号を取得する
●Print # ファイルにデータを書き込む
●Write # ファイルにデータを書き込む
●Input # ファイルからデータを1項目読み込む
●Line Input # ファイルからデータを1行読み込む
●Close ファイルを閉じる
●Reset ファイルをすべて閉じる

とわかりました。
ご丁寧なご対応有難うございます。


▼teian さん:
>▼VBA初心者 さん:
>>ありがとうございます。
>>ご教授いただいた内容でもテストして成功しました。
>>一つご質問がございます。
>>Open myFname For Output As #fnや
>>Print #fnやClose #fnの#fnはどのような意味でしょうか。
>>
>>よろしくお願い致します。
>>
>OpenステートメントのHelpをご確認下さい。

【66093】Re:範囲指定のCSV出力について
回答  mura  - 10/7/27(火) 12:06 -

引用なし
パスワード
   ▼VBA初心者 さん:
>ありがとうございます。
>ご教授、有難うございます。
> ご教授いただいたように試したのですが、出力したCSVが全項目出力
>され、BCDのシートが削除されEシートの項目でエラーが起きてしまいます。
>よろしくお願い致します。

マクロをシートモジュールに書いていますね...
先のコードは標準モジュールを想定していました。
以下のようにオブジェクトの親を明示すれば良いでしょう。

Private Sub csv_Click()
 Dim fname$
 fname = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\TEST.csv"
 Application.ScreenUpdating = False
 ActiveSheet.Copy
 With ActiveSheet
  .UsedRange.Value = .UsedRange.Value
  .Rows(1).Delete
  .Columns("B:D").Delete
 End With
 If Dir(fname) <> "" Then Kill fname
 With ActiveWorkbook
  .SaveAs fname, xlCSV
  .Close False
 End With
 Application.ScreenUpdating = True
 MsgBox "出力しました"
End Sub

【66110】Re:範囲指定のCSV出力について
発言  kanabun  - 10/7/31(土) 0:30 -

引用なし
パスワード
   ▼VBA初心者 さん:

>A1〜E100までデータが記載してあり、下記のコード
>を実行してA2〜A100までとE2〜E100までの2列のデータ
>のみをTEST.csvとして出力しようとしております。

こんにちは。
何だか皆さんのサンプルのいいとこ取りみたいで
ごめんなさいね
こういう方法ではどうでしょうか。

'標準モジュール
Sub SampleC()
 Dim oldSheet As Worksheet
 Dim newSheet As Worksheet
 Dim myDir As String
 Dim myFname As String
 
 
 'デスクトップのパス
 myDir = CreateObject("WScript.Shell").SpecialFolders("Desktop")
 'ファイル名の指定
 myFname = myDir & "\" & "TEST4.csv"

 Set oldSheet = ActiveSheet
 'シート1枚のBookを追加
 Set newSheet = Workbooks.Add(6).Worksheets(1)
 'そこへ元シートの2列だけCopy
 oldSheet.Range("A2:A100,E2:E100").Copy newSheet.Cells(1)

 'CSV形式で保存する
 With ActiveWorkbook
   .SaveAs myFname, xlCSV, Local:=True
   .Close False
 End With
 
End Sub

2763 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free