こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

複数の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から引用しました。)

投稿日時 - 2019-09-26 10:50:30

QNo.9660760

困ってます

質問者が選んだベストアンサー

質問内容のコードを書いてみました。メモ帳でUTF8ファイルを作って、Excelで読む(ダブルクリック)と文字化けし、回答のマクロを実行すると正常に読み込まれることを確認しました。
質問者様のファイル内容が分からないですが、参考に回答します。

下記マクロの「fPath」フォルダーにある複数のCSVファイルを読み込んで、「CSVshtName+番号」のシートを作成し、データを読み込みます。

処理の流れは、
既にある「CSVshtName+番号」のシートを削除
  ↓
1つ目のCSVファイルを読み込む
  ↓
出力用の「CSVshtName & 1」シートを作成
  ↓
CSVファイルのデータをシートに貼り付け
  ↓
2つ目のファイルがあれば読み込む。以下繰り返し。

シート削除の確認や、画面更新を止めて、最後に有効に戻しています。
標準モジュールに貼り付けます。当方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

投稿日時 - 2019-09-26 15:11:08

お礼

ありがとうございます。感動的でした。マクロが動いた際には、思わず「おぉ!美しい!」と叫びました。本当にありがとうございます。

投稿日時 - 2019-09-27 12:48:50

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

あなたにオススメの質問