![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?5a7ff87)
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で質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルのVBAについて とあるサイトのコードを参考に、CSVの文字化けを直すVBAを作成しているの 7 2022/11/04 14:15
- Visual Basic(VBA) マクロを短くする 1 2023/01/15 00:11
- Visual Basic(VBA) 複数のcsvファイルをExcelに一括変換したい 2 2023/03/03 12:44
- Visual Basic(VBA) マクロで最終行を取得してコピーしたい 3 2022/04/06 19:07
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
- Visual Basic(VBA) エクセル VBA 処理スピードを上げたいのですが。 6 2023/03/31 20:52
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Excel(エクセル) ExcelVBAについて。 2 2022/12/10 20:08
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Excel(エクセル) Excelのマクロコードについて教えてください。 1 2022/03/27 10:47
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルのVBAコードについて教...
-
マクロの記録を使用したマクロ...
-
VBAでCOPYを繰り返すと、処理が...
-
{ CONTROL Forms.Label.1}が...
-
vbaにてseleniumを使用したedge...
-
【ExcelVBA】インデックスが有...
-
VBの色を変えるにはどうしたら...
-
ユーザーフォームに別シートか...
-
プログラミング
-
VBAコードについて教えてくださ...
-
Excel 範囲指定スクショについ...
-
Excelのマクロについて教えてく...
-
エクセルVBAコードで教えて下さ...
-
Cellsのコードが打てません
-
エクセルのマクロについて教え...
-
現在のブックを閉じないで、マ...
-
VBA実行後に元のセルに戻りたい
-
Excelのマクロについて教えてく...
-
VBAで大量のファイルをシート名...
-
ExcelVBA シート名を複数セルか...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBAで大量のファイルをシート名...
-
VBA レジストリの値の読み方に...
-
Excelのマクロについて教えてく...
-
ユーザーフォームに別シートか...
-
VBAの計算で@が出てしまう件
-
エクセルVBAについて
-
Vba 実数および実数タイプの変...
-
【ExcelVBA】値を変更しながら...
-
VBA一覧取得 再投稿
-
VBA指定行削除
-
エクセルVBAについて
-
VBA ユーザーフォーム ボタンク...
-
VBA 何かしら文字が入っていたら
-
エクセルについて
-
2つのマクロでチェックボックス...
-
【マクロ】1つのマクロの中に...
-
ExcelのVBAコードについて教え...
-
VB.net(VB)で、フォームにExcel...
-
Vba SelStart、SelLen教えてく...
-
Excel-VBAのmsgBox()の不思議
おすすめ情報