【VAB】 エクセルファイルからCSVファイルをインポートするには

お世話になります
実行可能か、わからず質問させて頂きます。

■概要
・CSVファイルをエクセルファイルにインポートしたいです
■設置
・ユーザーフォームにテキストボックス、参照ボタン、実行ボタン
を生成
■動き
・参照ボタンをクリックするとダイアログボックスでCSVを選ぶ
・選んだあて先がテキストボックスに記載される
・実行ボタンでCSVをエクセルのシートに貼り付け
（このとき貼り付ける列はVB内で決めておきたい、1,4,5,6,9列を貼り付けるなど）

わかる方ご教授よろしくお願い申し上げます

No.3 ベストアンサー 回答者： fumufumu_2006 回答日時： 2008/04/11 06:33

>今の状態で2行目から貼り付けを実行させたいのですが可能ですか？

データ貼り付けの部分の
ws.Cells(r + 1, c + 1) = d(Val(cols(c)) - 1)
を
ws.Cells(r + 2, c + 1) = d(Val(cols(c)) - 1)
に変更してください。

もしも「CSVファイルの2行目から貼り付け・・・」と言う意味なら
For r = 0 To UBound(csv)
を
For r = 1 To UBound(csv)
に、
ws.Cells(r + 1, c + 1) = d(Val(cols(c)) - 1)
を
ws.Cells(r, c + 1) = d(Val(cols(c)) - 1)
に変更してください。

この回答へのお礼

まことにありがとうございました

なんとか目標に達成できました。ｍ（＿＿）ｍ

これからも頑張りたいとおもいます

お礼日時：2008/04/14 02:32

No.2 回答者： end-u 回答日時： 2008/04/10 21:43

こんにちは。

Option Explicit

Private Sub CommandButton1_Click()
　　Dim v
　　
　　v = Application.GetOpenFilename("CsvFiles, *.csv")
　　If VarType(v) <> vbBoolean Then
　　　　Me.TextBox1.Text = CStr(v)
　　End If
End Sub

Private Sub CommandButton2_Click()
　　Dim arg(1 To 256) As Long
　　Dim i As Long
　　
　　For i = 1 To 256
　　　　Select Case i
　　　　Case 1, 4, 5, 6, 9: arg(i) = 1
　　　　Case Else: arg(i) = 9
　　　　End Select
　　Next
　　With ActiveSheet
　　　　'.Range("A1").CurrentRegion.ClearContents
　　　　With .QueryTables.Add(Connection:="TEXT;" & Me.TextBox1.Text, _
　　　　　　　　　　　　　　　Destination:=.Range("A1"))
　　　　　　.RefreshStyle = xlOverwriteCells
　　　　　　.AdjustColumnWidth = False
　　　　　　.TextFileTextQualifier = xlTextQualifierDoubleQuote
　　　　　　.TextFileCommaDelimiter = True
　　　　　　.TextFileColumnDataTypes = arg
　　　　　　.Refresh BackgroundQuery:=False
　　　　　　.Parent.Names(.Name).Delete
　　　　　　.Delete
　　　　End With
　　End With
End Sub

...こんな感じです。
csvファイル読み込みは色んな手法があります。
Net検索してみると良いですよ。
上記の[QueryTable オブジェクト]を使う手法は
Excelメニューの[データ]-[外部データの取り込み]-[テキストファイルのインポート]です。
マクロの自動記録機能でコード生成されますから、参考にしてみてください。

No.1 回答者： fumufumu_2006 回答日時： 2008/04/10 21:35

こんなのではどうでしょうか？

csvファイルは単純なカンマ区切りのファイルだとします。（""で囲まれてるとかその他が無い）
ユーザーフォームのテキストボックス、参照ボタン、実行ボタンの名前は、そのままの名前になってるので、必要に応じて変えてください。

Option Explicit
Const selectColumns = "1,4,5,6,9" '抽出列

Private Sub 参照ボタン_Click()
Dim fileName As String
fileName = Application.GetOpenFilename("csvファイル,*.csv")
If fileName <> "False" Then
テキストボックス = fileName
End If
End Sub

Private Sub 実行ボタン_Click()
Dim fso As New FileSystemObject
'ファイルの存在チェック
If fso.FileExists(テキストボックス) = False Then
'ファイルなし
MsgBox "指定したファイルはありません"
Exit Sub
End If
'配列に全部読み込み
With fso.GetFile(テキストボックス).OpenAsTextStream
Dim csv() As String
csv = Split(.ReadAll, vbCrLf)
.Close
End With
'貼り付ける列を配列に
Dim cols() As String
cols = Split(selectColumns, ",")
'貼り付けるシート指定
Dim ws As Worksheet
Set ws = Sheets("Sheet1") '指定してください
ws.Cells.Clear 'クリア
'貼り付け
Application.ScreenUpdating = False '貼り付け中は画面がちらつかないように書き換えない
Dim r As Long
Dim c As Integer
For r = 0 To UBound(csv)
'csv1行分を配列に
Dim d() As String
d = Split(csv(r), ",")
For c = 0 To UBound(cols)
'指定列にデータがあれば（"1,2,3"の4列目は困るので）
If cols(c) - 1 <= UBound(d) Then
'データ貼り付け
ws.Cells(r + 1, c + 1) = d(Val(cols(c)) - 1) '配列の添え字は0からだけど、行列番号は1からのため、何だかわかりづらい
End If
Next
Next
Application.ScreenUpdating = True '表示再開
Set fso = Nothing
End Sub

この回答への補足

お返事ありがとうございます
できました、本当にありがとうございます
感動的です

まことに申し訳ないのですが、
もう1点お願いがあるのですが、今の状態で2行目から貼り付けを実行させたいのですが可能ですか？

最後に致しますので、なにとぞご教授よろしくお願い申し上げます

補足日時：2008/04/11 00:57

この回答へのお礼

まことにありがとうございます

お礼日時：2008/04/11 01:10