エクセルの固定範囲にCSVを貼り付ける。

エクセルの固定範囲にCSVを貼り付ける。

作ろうとしているのは、エクセルで作られた勤務表など
貼り付けすべき範囲が固定されているエクセルシートに、
ユーザーが選択したcsvを貼り付けるマクロです。

ユーザーが開いているエクセルファイル（勤務表.xlsとします）
に設置するボタンクリックイベントで、押下しますと
１．CSVファイルをユーザーが選択して開くことができ、
　（選択したCSVファイルをsamp1.csvとします）
２．そのsamp1.csvをエクセルで開いた時の固定範囲（B3からE33、など）を、
　　元のエクセルファイル、勤務表.xlsの固定位置
　　（Sheet1のC6からH36、など）に貼り付ける。
そんなマクロを作りたいと思っています。

エクセルのマクロに触れ始めて３時間余り、
エクセルマクロ入門系サイトや、
CSV貼り付け等のキーワードで検索し
類似件より引用しながら組んでいるのですが
知識も理解もあやふやなまま（当然かもしれませんが）なかなか作れません。

本来ならば入門書等に書かれている内容を読み、
その上で参考サイトを見て理解する程度になり、
その上で判らなければこちらで質問すべきと理解しているつもりですが、
今日中にと急かされながら3時間経っても理解が進まず半ばパニックに陥っております。

半ば丸投げな質問である事は承知しておりますが、
よろしければご教授、
ないしは私が目的とするマクロの参考になるサイトを
紹介して頂けませんでしょうか？

よろしくお願いします。

No.2 ベストアンサー 回答者： nak777r 回答日時： 2010/04/08 18:21

Sub ボタン1_Click()

Dim strFileName As String

' オープンするCSVファイルのフォルダを C:\ として
' ファイルオープンのダイアログを開く
ChDir ("C:\")
strFileName = Application.GetOpenFilename("CSVファイル (*.CSV),*.CSV", 1, "ファイルを選択")
If (strFileName <> "False") Then
' ファイル名が存在しない場合は抜ける
If (Trim(Dir(strFileName)) = "") Then
Call MsgBox("ファイルが見つかりません", vbOKOnly, "確認")
Else
'
' とりあえず、
' CSVの 1行目1列目(A1) から 3行目 4列目(D3)を
' このマクロがあるブックの シート名が "Sheet1" の B3～E5
' にコピーする事にする

'
' まず、コピー先である、このマクロがあるブックの シート名が
' "Sheet1" の B3～E5 の範囲をクリア
ThisWorkbook.Worksheets("Sheet1").Range("B3:E5").ClearContents


' 該当CSVファイルを新規BOOKとして読込んで開く
'
' 範囲 A1～D4 をコピー
' ペースト先はデータシートのB3セルから
Workbooks.Open Filename:=strFileName
ActiveSheet.Range("A1:D3").Copy _
Destination:=ThisWorkbook.Worksheets("Sheet1").Range("B3")

' コピー後、CSVファイルを閉じる
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End If
End If
End Sub

この回答へのお礼

nak777rさん、具体的なサンプルをありがとうございます。

早速試してみます。
解決後、再度報告に参ります。

お礼日時：2010/04/08 18:32

No.1 回答者： Hardking 回答日時： 2010/04/08 18:10

「前準備」

勤務表シートにコマンドボタン（検索ボタン）を付加する。
（コントロールツールボックスより選択）

検索ボタンクリック時の処理フロー
(1)．samp1.csvをＶＢＡマクロで参照する
(2).参照フィールドを該当のセルにデータ転記する

コーディング例
'(1)．samp1.csvをＶＢＡマクロで参照する

Dim field1,field2,field3 As String*/

'ＣＳＶファイルＯＰＥＮ
Open "samp1.csv" For Input As #1

Do While Not EOF(1)

'ＣＳＶファイル参照
Input #1, field1, field2, field3

　　　　'(2).参照フィールドを該当のセルにデータ転記する
ActiveSheet.Cells(1, 1).Value = field1
ActiveSheet.Cells(1, 2).Value = field2
ActiveSheet.Cells(1, 3).Value = field3
Loop

'ＣＳＶファイルＣＬＯＳＥ
Close #1

この回答への補足

報告が遅れて済みません。

アドバイス頂けた後、程なく目的を果たすマクロを作成する事ができました。
また、エクセルVBAへの理解を深める事もできました。
本当にどうすればいいか慌てていた時でしたので本当に助かりました。
ありがとうございました。

補足日時：2010/04/15 12:14

この回答へのお礼

Hardkingさん、
すっきりとしたサンプルコードをありがとうございます。
早速試してみます。
解決、再度後報告に参ります。

お礼日時：2010/04/08 18:30