vba で まとめてcsv読み込み
大量のcsvを読み込んでExcel処理したかったので手動は面倒くさくてvbaに初挑戦したメモ。
OpenTextではなぜかセミコロン区切りのものをうまく読み込んでくれず、手動でやってるときはクエリを使っていたことを思い出しQueryTableを使用。
vba入門はこちらを、
color-chips.net
複数ファイルの読み込みはこちらを、
color-chips.net
QueryTableの使い方はこちらを
water2litter.net
参考にさせていただきました。
Sub QueryMultiCSVFiles() ' [[ 変数定義 ]] Dim varFileName As Variant Dim FileName As Variant Dim CSVWorkSheet As Worksheet Dim NewWorkSheet As Worksheet Dim SheetName As String Dim qt As QueryTable ' [[ 複数ファイルパス名を取得 ]] varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", Title:="CSVファイルの選択", MultiSelect:=True) ' [[ ファイルパス取得できなかったら ]] If IsArray(varFileName) = False Then Exit Sub MsgBox "Isarray Error" End If ' [[ ファイルパス取得できたら ]] For Each FileName In varFileName ' [[ ファイルパスからファイル名を取得 ]] SheetName = Dir(FileName) ' [[ ファイル名で新しいシート作成 ]] Set NewWorkSheet = CreateWorkSheet(SheetName) Set CSVWorkSheet = ActiveSheet Set qt = CSVWorkSheet.QueryTables.Add(Connection:="TEXT;" & FileName, Destination:=CSVWorkSheet.Range("A1")) With qt .TextFilePlatform = 932 ' 文字コードを指定 .TextFileParseType = xlDelimited ' 区切り文字の形式 .TextFileSemicolonDelimiter = True ' カンマ区切り .RefreshStyle = xlOverwriteCells ' セルに上書き .Refresh .Delete ' CSV との接続を解除 End With Next End Sub ' [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]] ' [[ ]] ' [[ ワークシート名を指定したワークシートの作成 ]] ' [[ ]] ' [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]] Function CreateWorkSheet(WorkSheetName As String) As Worksheet ' 変数定義 Dim NewWorkSheet As Worksheet Dim WS As Worksheet Dim iCheckSameName As Integer ' ワークシートの作成 ' ※一番最後に挿入 Set NewWorkSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count)) ' 同じ名前ワークシートが無いか確認 iCheckSameName = 0 For Each WS In Sheets If WS.Name = WorkSheetName Then MsgBox "ワークシート名:" + WorkSheetName + " この名前は既に使われています。" iCheckSameName = 1 End If Next '同じ名前のワークシートがなければ If iCheckSameName = 0 Then NewWorkSheet.Name = WorkSheetName Set CreateWorkSheet = NewWorkSheet End If End Function