複数のCSVファイルを一つのブックに
- エクセルvbaで複数のCSVファイルを一つのブックにシートを分けて取り込む方法を教えてください。
- 複数のCSVファイルを一気に取り組みたい、一つのブックにCSVファイル別にシートを分けたい、文字化けを解消したいという問題を解決する方法を教えてください。
- VBA初心者ですが、エクセルvbaで複数のCSVファイルを一つのブックにシートを分けて取り込む方法を教えてください。また、文字化けを解消する方法も教えていただきたいです。
- ベストアンサー
複数のCSVファイルを一つのブックに
エクセルvbaの達人の皆様、どうか助けてください。 フォルダ内の複数のCSVファイルを一つのブックにシートを分けて取り込むvbaが知りたいです。問題は、 ・複数のcsvを一気に取り組みたい ・一つのブックに、csvファイル別にシートを分けたい ・文字化けを何とかしたい！！（文字コードをutf8にしたい） この3つをクリアすることですが、、 ネットで調べてみたところ、あるページに載っている以下のマクロを試してみたのですが、やはり文字化けしてしまいます。文字コードの設定をどこかで指定しなければならないと思いますが、どう改良すればよろしいでしょうか。（ちなみに、VBAは全くの初心者です） Sub test() Dim myObj As Object Dim myDir As String Dim myFileName As String Dim myc As Long Application.ScreenUpdating = False Set myObj = CreateObject("Shell.Application"). _ BrowseForFolder(0, "取り込むフォルダを選択してください", 0) If myObj Is Nothing Then Exit Sub myDir = myObj.Items.Item.Path If Right(myDir, 1) <> "\" Then myDir = myDir & "\" 'フォルダ内のExcelファイルを確認 myFileName = Dir(myDir & "*.csv") myc = 0 Do While myFileName <> "" Workbooks.Open (myDir & myFileName) myc = myc + 1 Workbooks(myFileName).Worksheets(1).Move ThisWorkbook.Worksheets(1) myFileName = Dir() Loop If myc = 0 Then MsgBox "CSVファイルがありません。" End If Application.ScreenUpdating = True End Sub （上記のマクロはhttp://www.excel.studio-kazu.jp/kw/20110705155353.html#commentから引用しました。）
- wonychoi
- お礼率50% (1/2)
- Excel（エクセル）
- 回答数2
- ありがとう数1
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
質問内容のコードを書いてみました。メモ帳でUTF8ファイルを作って、Excelで読む（ダブルクリック）と文字化けし、回答のマクロを実行すると正常に読み込まれることを確認しました。 質問者様のファイル内容が分からないですが、参考に回答します。 下記マクロの「fPath」フォルダーにある複数のCSVファイルを読み込んで、「CSVshtName+番号」のシートを作成し、データを読み込みます。 処理の流れは、 既にある「CSVshtName+番号」のシートを削除 ↓ １つ目のCSVファイルを読み込む ↓ 出力用の「CSVshtName & 1」シートを作成 ↓ CSVファイルのデータをシートに貼り付け ↓ ２つ目のファイルがあれば読み込む。以下繰り返し。 シート削除の確認や、画面更新を止めて、最後に有効に戻しています。 標準モジュールに貼り付けます。当方win10、Excel2010です。 ご参考に。 Sub CSV2XLSX() Dim ws As Worksheet '// ワークシート Dim fPath As String '// ファイルのパス fPath = "N:\履歴\Work" Const CSVshtName = "CSV_Sheet" '// CSV出力シート名 Application.ScreenUpdating = False Application.DisplayAlerts = False '// 既にあるCSV出力用シートを削除 For Each ws In Sheets If Left(ws.name, 9) = CSVshtName Then ws.Delete End If Next '// CSVファイルを読む Dim queryTb As QueryTable Dim fExp As String '// 拡張子 Dim fName As String '// ファイルフルパス Dim idxCSVSheet As Integer '// CSVファイルの番号 fExp = "*.csv" fName = Dir(fPath & "\" & fExp) While fName <> "" idxCSVSheet = idxCSVSheet + 1 Worksheets.Add(After:=Worksheets(Worksheets.Count), Count:=1). _ name = CSVshtName & idxCSVSheet Set ws = ActiveSheet Set queryTb = ws.QueryTables.Add(Connection:="TEXT;" & _ fPath & "\" & fName, _ Destination:=ws.Range("A1")) '// CSVファイルを開く With queryTb .TextFilePlatform = 65001 '// 文字コード .TextFileParseType = xlDelimited '// 区切り文字 .TextFileCommaDelimiter = True '// カンマ区切り .RefreshStyle = xlOverwriteCells '// 書き込む方式 .Refresh '// データ表示 .Delete '// CSVとの接続解除 End With fName = Dir() Wend Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
その他の回答 (1)
- kurokuro_siro
- ベストアンサー率12% (337/2675)
関連するQ&A
- 複数のCSVファイルを自動でエクセルに変換したい
フォルダの中に、300近いCSVフォルダがあります。 ネットで探したマクロVBAでやってみたところ、一つのCSVファイルを選び、それをエクセルファイルに変換できました。 このマクロを使って、フォルダ内にあるすべてのCSVファイルを一気にエクセルに変換するには、どうしたらいいのでしょうか。 ご教授のほど、よろしくお願いいたします。 Sub CSVからXLSX() Dim varFileName As Variant varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _ Title:="CSVファイルの選択") If varFileName = False Then Exit Sub End If Workbooks.Open Filename:=varFileName ActiveSheet.Cells.Copy ThisWorkbook.ActiveSheet.Cells ActiveWorkbook.Close SaveChanges:=False End Sub
- 締切済み
- Excel（エクセル）
- CSV
複数の定型フォームのCSVファイルを１エクセルファイルにして、エクセル上で集計まで行いたいと思っています。 今、「教えて！goo」から検索で、VBAを使って、CSVファイルをエクセルの１シートにまとめることはできたのですが、 ・シート名を特定の名前にしたい ・同ファイル内の、既存の「TTL」というシート上で合計を表示させたい のですが、シート名が定まらないので設定ができません。 どうか、設定方法を教えてください。 VBA式は以下のとおり ↓↓↓ Dim MyObj As Object Dim MyFol As String Dim MyFnm As String Dim MyStr As String Dim i As Long Dim n As Long Dim n1 As Long 'フォルダを選択する Set MyObj = CreateObject("Shell.Application") _ .BrowseForFolder(0, "SelectFolder", 0) '選択なければ処理を抜ける If MyObj Is Nothing Then Exit Sub MyFol = MyObj.self.Path & "\" MsgBox MyFol & "を処理します。" Set MyObj = Nothing Application.ScreenUpdating = False 'ThisWorkbookにシートを追加して処理 With Sheets.Add 'Dir関数を使って指定フォルダ内csvファイルを順次処理 MyFnm = Dir(MyFol & "*.csv") Do Until Len(MyFnm) = 0& i = i + 1 'データエリアを取得してセット先を変更 n = IIf(n = 0, 1, n + n1) '外部データ取り込みを利用 With .QueryTables.Add(Connection:="TEXT;" & MyFol & MyFnm, _ Destination:=.Range("B" & n)) .AdjustColumnWidth = False .TextFilePlatform = xlWindows .TextFileStartRow = 1 .TextFileCommaDelimiter = True .Refresh False n1 = .ResultRange.Rows.Count .Parent.Names(.Name).Delete .Delete End With 'ファイル名をA列にセット .Range("A" & n).Resize(n1).Value = MyFnm '次のファイルへ MyFnm = Dir() Loop End With If i > 0 Then MyStr = i & "個のファイルを処理しました。" Else '検索結果が０なら MyStr = "検索条件を満たすファイルはありません。" End If Application.ScreenUpdating = True MsgBox MyStr
- ベストアンサー
- オフィス系ソフト
- 複数の.csvファイルから指定数値を取り出す
毎度御世話になります。 あるフォルダ内の複数の.csvファイル一つ一つから 指定数値(B列6行目のみ)を取り出して、 デスクトップ上、別のExcelシートの(B列１行毎に日付と時間が書いてある) 隣のC列にまとめて自動で書いてくれるプログラムを考えます。 使用するファイル名は HU20150513_110000_AI2.csv です。 コードの該当行'ファイル名を配列変数に格納 のところを、 上記ファイル名にしても、「型が一致しません」とエラーが出るのですが、 どこか他に変更点があるのでしょうか。詳しい方、宜しく御願い申し上げます。 ■VBAコード Sub 値取得() '配列変数を宣言 Dim filnames As Variant Dim myfile As Variant Dim cnt As Long Dim mybook As Workbook Dim outbook As Worksheet Dim fname As String Dim mySerial As Date Dim myRng As Variant Dim key As String '出力先の先頭行番号 cnt = 1 '出力先のブックを格納 Set outbook = ActiveWorkbook.ActiveSheet 'ファイル名を配列変数に格納 filnames = Application.GetOpenFilename("CSVファイル (*.csv), *.csv", MultiSelect:=True) 'キャンセル時の処理 If IsArray(filnames) = False Then Exit Sub 'ファイルの数だけ繰り返し Application.ScreenUpdating = False For Each myfile In filnames 'ファイル開く Set mybook = Workbooks.Open(Filename:=myfile, ReadOnly:=True) 'ファイル名からシリアル値の作成 fname = Format(Left(mybook.Name, 12), "0000/00/00 00:00") mySerial = DateValue(fname) + TimeValue(fname) '値を取得・出力先へ書き出し mybook.Activate key = Year(mySerial) & Month(mySerial) & Day(mySerial) & Hour(mySerial) For Each myRng In outbook.Columns("B").SpecialCells(xlCellTypeConstants, 23) If IsDate(myRng) Then If Year(myRng) & Month(myRng) & Day(myRng) & Hour(myRng) = key Then myRng.Offset(0, 1).Value = ActiveSheet.Range("B6").Value Exit For End If End If Next myRng 'ファイル閉じる Application.DisplayAlerts = False Workbooks(mybook.Name).Close Application.DisplayAlerts = True 'カウントアップ cnt = cnt + 1 Next myfile Application.ScreenUpdating = True End Sub
- 締切済み
- Excel（エクセル）
- VBA：2つのCSVファイルを開きたいです。
エクセル2010のVBAにてCSVファイルを開き結合させるプログラムを組もうとしているのですが、2つ目のCSVファイルを開こうとすると、何故かエラーが出てしまいます。 -------------------------------------------------------------------------------- 1つ目 Sub mobile_FileSearch(Path As String) 'test.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call mobile_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "test.csv" Then Workbooks.Open ("test.csv") End If Next File End Sub ---------------------------------------------------------------------------- 2つ目 Sub local_FileSearch(Path As String) 'bbb.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call local_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "bbb.csv" Then Workbooks.Open ("bbb.csv")'←ここでエラー End If Next File End Sub ------------------------------------------------------------------------ まったく同じプログラムで、csvファイル名だけ変えただけで実行時エラー1004が出てしまいます。 一体全体何が問題なのでしょうか？
- ベストアンサー
- その他（プログラミング・開発）
- ファイルが既に開いているかどうかを取得するには
Sub Sample1() Dim App As Object Dim MyFileName As String Set App = CreateObject("Excel.Application") MyFileName = "C:\Users\test.xlsm" With App .Workbooks.Open Filename:=MyFileName .Visible = True If .ReadOnly Then MsgBox "既に開いています" App.Quit '既に開いているのなら、閉じる End If End With End Sub このようなコードを作ったのですが、どうやらIf .ReadOnly Thenの部分が間違っているようです。 エラーになります。 既にファイルが開いているか、読み取り専用かどうかを取得するコードをご教授ください。
- ベストアンサー
- Excel（エクセル）
- Excelのブック間の串刺し計算について
Excelのブック間の串刺し計算について VBA超初心者です。同じフォルダ内にファイルがいくつかあり、同じ形式で、sheet1のB4のセルに計があったとして、それをブック間で串刺し集計したいのですが、うまくいきません。どこが悪いのかもわからず、困り果ててます。ご指導お願いします。 Sub BookShuukei() Dim FileName As String Dim Total As Integer Dim OpenedBook As Workbook Dim IsBookOpen As Boolean FileName = Dir("*.xls") Application.ScreenUpdating = False Do While FileName <> "" If FileName <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If Total = Total + Workbooks(FileName).Sheets(1).Range("B4").Value If IsBookOpen = False Then Workbooks(FileName).Close End If End If FileName = Dir() Loop Application.ScreenUpdating = True MsgBox (Total) End Sub
- 締切済み
- オフィス系ソフト
- Textboxに入力してBookを開く
VBAを勉強して仕事に活かしたいと思っています。 ユーザーフォームを有効に使いたいと・・ TextboxにBook名を入力してBook（同一フォルダー内にある）を開けるようにしたいと思い次のコードを書きましたが全てのBookが開いてしまいました。 Dim MyP As String Dim MyF As String Dim NewBK As Workbook Dim flg As Boolean MyP = ThisWorkbook.Path & Application.PathSeparator MyF = Dir(MyP & "*.xls") Application.ScreenUpdating = False Do While MyF <> "" If MyF <> ThisWorkbook.Name Then On Error Resume Next Set NewBK = Workbooks(MyF) On Error GoTo 0 If NewBK Is Nothing Then flg = True Set NewBK = Workbooks.Open(MyP & MyF) End If 検索_1 NewBK If flg Then NewBK.Close False flg = False End If Set NewBK = Nothing End If MyF = Dir() Loop Application.ScreenUpdating = True ThisWorkbook.Activate End Sub '*** Form呼び出し時の処理 *** Private Sub 検索_1() Dim findText As String '探す文字列(Text1に入力) Dim rg As Object '探し出したブック findText = Text1.Text Set rg = Workbooks.Find(What:=findText, LookAt:=xlWhole) If Not rg Is Nothing Then Workbooks.Open End If End Sub このコードは本やネットの過去ログをみて参考にして書いたものです。 どなたかわかる方 アドバイスお願いします。
- 締切済み
- Visual Basic
- マクロを使用してCSVファイルの結合を行いたい
過去の質問の中から、素晴らしい結合のマクロを見つけましたが、パソコンをwindows7にエクセルを エクセル2010に変更した後、マクロが使えなくなりました。 どなたか修正して頂けないでしょうか？ 列の項目は定形で、10～200行のデータが書かれたCSVファイルが1つのフォルダに多数あります。 新しいファイルに、NO.1のファイルのデータの続きにNO.2、NO.3・・・と続けてデータが下の行に連続 して並ぶようにマクロで結合させたいと思っていますので、宜しくお願いします。 Sub Test1() Dim files As FileSearch, FilesCnt As Integer, i As Integer Dim cBook As Workbook, pBook As Workbook FilesCnt = mySearch(files, ThisWorkbook.Path) If FilesCnt = 0 Then Exit Sub Set pBook = Workbooks.Add(xlWBATWorksheet) For i = 1 To FilesCnt Workbooks.Open files.FoundFiles(i) Set cBook = ActiveWorkbook cBook.ActiveSheet.UsedRange.Copy With pBook.ActiveSheet If i > 1 Then .Cells(.Range("A65536").End(xlUp).Row + 1, 1). _ PasteSpecial (xlPasteAll) Else .Cells(.Range("A65536").End(xlUp).Row, 1). _ PasteSpecial (xlPasteAll) End If End With Application.CutCopyMode = False cBook.Close Next i Set cBook = Nothing: Set pBook = Nothing End Sub '******************************************************************** Function mySearch(files As FileSearch, myDir As String) As Integer mySearch = 0 Set files = Application.FileSearch With files .NewSearch .LookIn = myDir .SearchSubFolders = True .Filename = "*.csv" If .Execute() > 0 Then mySearch = .FoundFiles.Count End With End Function
- ベストアンサー
- オフィス系ソフト
- サンプルプログラムでエラーが出てしまいます、対処法を教えて下さい。
Sub test写真の連続挿入() Dim myDir As String Dim myFile As String Dim i As Integer Dim n As Integer n = 10 myDir = "D:\写真\" myFile = Dir(myDir, vbNormal) Application.ScreenUpdating = False Do Until myFile = "" If myFile <> "." And myFile <> ".." Then If (GetAttr(myDir & myFile) And 16) <> 16 Then i = i + 1 With ActiveSheet.OLEObjects("Image" & i) .Object.PictureSizeMode = 3 .Object.Picture = LoadPicture(myDir &myFile) End With If i = n Then Exit Do End If End If myFile = Dir Loop Application.ScreenUpdating = True End Sub このWith ActiveSheet.OLEObjects("Image" & i)の行でエラーが出てしまいます、対処法を教えて下さい。（ 実行時エラー'1004'OLEObjects プロパティを取得できません）
- 締切済み
- Visual Basic
- 複数のCSVファイルを読み込んで複数シートを1ブックとしたい
始めまして。 VBA初心者です。 2枚のCSVファイルをダイアログで各々指定し、保存する2枚のシートを1ブックにまとめたいのですが、うまくいきません。 現状は以下のようなマクロですが、別々のシートとなります。 よろしくお願い致します。 Sub 選択されたPDPファイルを開いて読み込む() With Application.FileDialog(msoFileDialogOpen) .Title = "ファイルを選択して［OK］ボタンをクリックしてください" .AllowMultiSelect = False '複数選択不可 .Filters.Clear .Filters.Add "1枚目", "*.csv", 1 If .Show = -1 Then .Execute 'キャンセルでなければ開く End With With Application.FileDialog(msoFileDialogOpen) .Title = "2つめのファイルを選択して［OK］ボタンをクリックしてください" .AllowMultiSelect = False '複数選択不可 .Filters.Clear .Filters.Add "2枚目", "*.csv", 1 If .Show = -1 Then .Execute 'キャンセルでなければ開く End With End Sub
- ベストアンサー
- オフィス系ソフト
お礼
ありがとうございます。感動的でした。マクロが動いた際には、思わず「おぉ！美しい！」と叫びました。本当にありがとうございます。