Excel VBを使って、デスクトップにあるcsv形式のデータを取り込むマクロを作りました(「マクロの記録」にて)。データは10個あるので、同じようなマクロを10個作っています。
そこで、取り込むcsvのファイル名ですが、01.csv、02.csv、…、10.csvという名前になるように1つ1つ名前の変更をしてから取り込んでいます。
これをもとのファイル名のままで、番号の若いもの順から取り込むということは出来ないでしょうか。
元のファイル名は「1002.csv」「1234.csv」「3456.csv」などと「(4ケタの数字).csv」です。
今、使っているVBは以下の通りです(長くてすみません)。
どうぞよろしくお願いいたします。
------------------------------------------------------------------------
Sub data01取り込み()
'
' data01取り込み Macro
'
'
Sheets("data1").Select
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\user\Desktop\データ\01.csv", Destination:=Range("$A$1"))
.Name = "cell1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("E2:E400").Select
Selection.Copy
Sheets("計算").Select
ActiveWindow.SmallScroll Down:=-16
Range("e4").Select
ActiveSheet.Paste
End Sub
----------------------------------------------------------------
No.5ベストアンサー
- 回答日時:
失礼しました。
途中までですが以下でどうでしょう?
メニューの挿入から標準モジュールに張り付けてお試しください。
data1 ~data10 のシートがすでにある前提です。
Sub 取り込みメイン()
Dim FileList() As Variant, tmpName As Variant
Dim i As Integer
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = Environ("userProfile") & "\desktop"
.Filters.Clear
.Filters.Add "CSVファイル", "*.csv"
.Filters.Add "すべてのファイル", "*.*"
.FilterIndex = 1
If CBool(.Show) Then
'選択ファイルのパスの格納
ReDim Preserve FileList(.SelectedItems.Count - 1)
For Each tmpName In .SelectedItems
FileList(i) = tmpName
i = i + 1
Next
Else
MsgBox "選択ファイルが無いので中止しました"
Exit Sub
End If
End With
For i = LBound(FileList) To UBound(FileList)
'Debug.Print FileList(i), i
Call 取り込みSheet(FileList(i), i + 1)
Next
End Sub
Private Sub 取り込みSheet(ByVal MyFileName As String, ByVal MyFileNo As Integer)
Worksheets("data" & CStr(MyFileNo)).Select
Cells.Delete '必要に応じて不要かも
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & MyFileName, Destination:=Range("$A$1"))
.Name = "cell" & CStr(MyFileNo) 'cell1~cell10 まで名前
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
' Range("E2:E400").Select
' Selection.Copy
' Sheets("計算").Select
' ActiveWindow.SmallScroll Down:=-16
' Range("e4").Select
' ActiveSheet.Paste
End Sub
なお、最後のコメントアウト部分の6行が不明です。
data1~data10シートのE列を計算シートに転記されているようですが
計算シートはE4から始まって?
各data1~data10の行は2~400で固定?
NotFound404さん、ご回答、本当にありがとうございます。
お礼が大変遅くなり申し訳ありません。
(他のマクロのエラーと格闘しておりました(^-^;)
最後の6行は、データを取り込んだ後の次の処理でしたので、今回お聞きしたかったことはばっちり解決しました!(コードを全部書いてくださっているので、当たり前ですよね(汗))
私自身、よくわかっていない部分が多いので、質問自体もわかりづらかったかと思いますが、根気強く付き合ってくださってありがとうございました!
No.4
- 回答日時:
>こちらで試した限りでは昇順になっていましたが果たして?
は大丈夫でしたかね?
10個のファイルがそれぞれ
一番目→Sheets("data1")
二番目→Sheets("data2")
十番目→Sheets("data10")
に入る。
のなら前回回答を変更して
For i = LBound(FileList) To UBound(FileList)
'Debug.Print FileList(i),i
Call data取り込み(FileList(i),i+1)
Next
Private Sub data取り込み(MyFileName As String,MyFileNo as integer)
Sheets("data" & cstr(myfileno)).Select
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myfilename, Destination:=Range("$A$1"))
.Name = "cell" & cstr(myfileno)
以下はあなたのオリジナルのまま
End Sub
で良いかもです。
.Name = "cell" & cstr(myfileno)
の部分に一抹の不安があります。
ご回答、本当にありがとうございます。
それにもかかわらず、エラーばかりで…。
--------------------------------
For i = LBound(FileList) To UBound(FileList)
'Debug.Print FileList(i),i
Call data取り込み(FileList(i), i + 1) <-----------エラーが出るところ
Next
--------------------------------
上記のところで「コンパイルエラー ByRef引数の型が一致しません」が出てしまいます。
前回は別のところでコンパイルエラーが出てしまい、いずれも前に進めずにおります。
せっかくご回答くださったのに、それを生かすことができず申し訳ありません。
No.3
- 回答日時:
#1です。
すでに#2さんが示されたように、
「ここは新規に作って下さい」の部分を工夫して下さい。
ワークシート上にデータ入力してソートして、上から順に読むも良し。
No.2
- 回答日時:
下記みたいな感じで出来ないかな?
こちらで試した限りでは昇順になっていましたが果たして?
投稿用にタブインデントを全角スペースで代用しています。
Sub test()
Dim FileList() As Variant, tmpName As Variant
Dim i As Integer
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = Environ("userProfile") & "\desktop"
.Filters.Clear
.Filters.Add "テキストファイル", "*.csv;*.txt"
If CBool(.Show) Then
'選択ファイルのパスの格納
ReDim Preserve FileList(.SelectedItems.Count - 1)
For Each tmpName In .SelectedItems
FileList(i) = tmpName
i = i + 1
Next
End If
End With
For i = LBound(FileList) To UBound(FileList)
Debug.Print FileList(i)
'Call data01取り込み(FileList(i))
Next
End Sub
Private Sub data01取り込み(MyFileName As String)
'前略
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & MyFileName, Destination:=Range("$A$1"))
'中略
End With
End Sub
ご回答、ありがとうございます。
頂いた回答をもとにチャレンジしていますが、省略部分がうまく埋められないようで、
エラーばかり出てしまいます…(汗)
この週末に再度、じっくり取り組んでみます。
本当にありがとうございます。
No.1
- 回答日時:
今のコードを最大限流用
Sub data取り込み実行()
'ここは新規に作って下さい
Call data取り込み("data1", "1002.csv")
Call data取り込み("data2", "1234.csv")
Call data取り込み("data3", "3456.csv")
''''以下、略
end sub
Sub data取り込み(strシート名 as string, strファイル名 as string)
' ここは流用
' ' data01取り込み Macro '
'
Sheets(strシート名).Select Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;C:\Users\user\Desktop\データ\” & strファイル名, Destination:=Range("$A$1")) .Name = "cell1"
''''以下略
早速のご回答、ありがとうございます!
「(4ケタの数字).csv」の4ケタの数字の部分は、毎回変わります。
これを小さいもの順から取り込むというのは出来ないでしょうか。
さらなる質問となり、申し訳ありません。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセル タブの下のメニューを...
-
Web画面の文字をVB6で取得したい
-
Excel VBA 定義されたプロージ...
-
配列のペースト出力結果の書式...
-
ExcelVBA シート名を複数セルか...
-
VB.net(VB)で、フォームにExcel...
-
VBA 別ブックから条件に合うも...
-
エクセルのマクロついて教えて...
-
サブフォルダに格納されている...
-
VBA レジストリの値の読み方に...
-
Outlookの「受信日時」「件名」...
-
VBA実行後に元のセルに戻りたい
-
エクセルのマクロについて教え...
-
【ExcelVBA】インデックスが有...
-
VBA 別ブックからコピペしたい...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
IF文、条件分岐の整理方法
-
VBA listBoxから
-
VBAの質問になります 行の非表示
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBA 別ブックからコピペしたい...
-
Vba ファイル書き込み時に書き...
-
Excel_VBAについて質疑です。(...
-
VBAの間違い教えて下さい
-
VBA コードどこがおかしいですか?
-
VBA 円グラフ 特定条件に一致し...
-
VBA 別ブックから条件に合うも...
-
pdfファイルの複数添付 引数の型
-
【ExcelVBA】インデックスが有...
-
ExcelVBAマクロで実行した時の疑問
-
Vba UserformからExcelシートの...
-
VBA初心者です。次のVBAコード...
-
Outlookの「受信日時」「件名」...
-
Excel 範囲指定スクショについ...
-
vbs ブック共有を解除
-
配列のペースト出力結果の書式...
-
Excel VBAで値を変えながら、pd...
-
VB.net(VB)で、フォームにExcel...
-
vbaにてseleniumを使用したedge...
-
ExcelVBA シート名を複数セルか...
おすすめ情報