フォルダ内のExcel・CSVを1つにまとめるマクロ。コインチェックのデータにも対応

フォルダに入っているExcel、CSVファイルを1つにまとめたいときは、マクロを使わざるを得ません。
EX IT 2
※Keynoteで作成

Excelマクロなら複数ファイルを結合できる

たとえば、こういった複数のファイルがあるとき、
EX IT 3

集計やチェックのために
「1つにまとめたい」
ということはあるはずです。

こんなとき、現実的には、ファイルを開いてコピペを繰り返さざるを得ません。

コピペをしないならマクロを使います。
過去に、「開いているファイルをまとめる」マクロは紹介してきました。

今回紹介するのは、フォルダ内にあるファイルを1つにまとめるマクロです。
結合したいファイルを1つのフォルダにあらかじめ入れておきます。

結合したいファイルの種類(ExcelかCSV)を選択して、
EX IT 4

[フォルダ指定]ボタンを押せば、フォルダを指定でき、[結合]ボタンを押せば、
EX IT 5

フォルダ内のファイル(すべてのシート)が1枚のシートにまとまります。
EX IT

ファイルが何10個、何100個あってもやることは同じです。

■スポンサードリンク

フォルダ内のExcel・CSVを1つにまとめるマクロ

今回のマクロはこういったプログラムです。
2つのプログラムを書いています。

Sub folder()

    If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
        Range("b2").Value = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
    End If

End Sub

Sub merge()


'シート[merge]を削除
    On Error Resume Next
    Application.DisplayAlerts = False
       Worksheets("merge").Delete
    Application.DisplayAlerts = True
    
'シート[merge]を一番右に追加
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "merge"
    
'フォルダの場所を変数に入れる
    Dim Folder_path
    Folder_path = ThisWorkbook.Worksheets("folder").Range("b2").Value
    
  
'結合するブックを変数に入れる
    Dim FileType
    If Worksheets("folder").Range("b1").Value = "Excel" Then
        FileType = "\*.xls*"
    Else
        FileType = "\*.csv"
    End If
    
    
    Dim MergeWorkbook
    MergeWorkbook = Dir(Folder_path & FileType)

    
'指定したフォルダから、ファイルを探して、開いてコピペ
    Do Until MergeWorkbook = ""
        Workbooks.Open Filename:=Folder_path & "\" & MergeWorkbook
        
    
        Dim MergeWorkbook_data  '結合するブック内のシートのデータ数
        Dim ThisWorkbook_data  '結合先のシートのデータ数
       
        
        Dim i
        For i = 1 To Workbooks(MergeWorkbook).Worksheets.Count
        
            MergeWorkbook_data = Workbooks(MergeWorkbook).Worksheets(i).Range("a" & Rows.Count).End(xlUp).Row
            ThisWorkbook_data = ThisWorkbook.Worksheets("merge").Range("a" & Rows.Count).End(xlUp).Row
            
            Workbooks(MergeWorkbook).Worksheets(i).Rows("1:" & MergeWorkbook_data).Copy ThisWorkbook.Worksheets("merge").Range("a" & ThisWorkbook_data + 1)
        Next
    
           
    '結合するブックを閉じる
        Application.DisplayAlerts = False
            Workbooks(MergeWorkbook).Close
        Application.DisplayAlerts = True
    
'次のブックを探しに行く
        MergeWorkbook = Dir()
    Loop
   

End Sub

まず、この部分でフォルダを指定するプログラムを書いています。
指定したフォルダのフォルダ名をセルB2に入れ、それを次のプログラムで使うという処理です。

Sub folder()

    If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
        Range("b2").Value = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
    End If

End Sub

ボタンに設定する方法はこちらを参考にしていただければ。

ファイルを結合する先は、mergeというシートにしています。
繰り返しこのファイルを使うことを考えると、このシートを最初に削除しておく必要があります。
前のデータが残ってしまいますので。
ただし、「シート[merge]を削除」という指示をして、そのシート[merge]がないとエラーが出て処理がとまってしまうので、「[merge]がなかったら無視して」というプログラムも合わせて入れています。
こういうところがプログラミングの面白いところです。

その後に、シート[merge]を追加します。

Sub merge()


'シート[merge]を削除
    On Error Resume Next
    Application.DisplayAlerts = False
       Worksheets("merge").Delete
    Application.DisplayAlerts = True
    
'シート[merge]を一番右に追加
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "merge"
    

セルB2に入ったフォルダ名をここで使います。
そのフォルダにある、セルB1で指定した種類のファイルを探す設定をして準備完了です。;

 
'フォルダの場所を変数に入れる
    Dim Folder_path
    Folder_path = ThisWorkbook.Worksheets("folder").Range("b2").Value
    
  
'結合するブックを変数に入れる
    Dim FileType
    If Worksheets("folder").Range("b1").Value = "Excel" Then
        FileType = "\*.xls*"
    Else
        FileType = "\*.csv"
    End If

    Dim MergeWorkbook
    MergeWorkbook = Dir(Folder_path & FileType)

    

指定したフォルダから、ファイルを探して、見つかったら、それを開いて、コピーして、シート[merge]に貼り付けていきます。
終わったらそのファイルを閉じ、次のファイルを探しに行き、見つからなくなるまで繰り返すわけです。

'指定したフォルダから、ファイルを探して、開いてコピペ
    Do Until MergeWorkbook = ""
        Workbooks.Open Filename:=Folder_path & "\" & MergeWorkbook
        
    
        Dim MergeWorkbook_data  '結合するブック内のシートのデータ数
        Dim ThisWorkbook_data  '結合先のシートのデータ数
       
        
        Dim i
        For i = 1 To Workbooks(MergeWorkbook).Worksheets.Count
        
            MergeWorkbook_data = Workbooks(MergeWorkbook).Worksheets(i).Range("a" & Rows.Count).End(xlUp).Row
            ThisWorkbook_data = ThisWorkbook.Worksheets("merge").Range("a" & Rows.Count).End(xlUp).Row
            
            Workbooks(MergeWorkbook).Worksheets(i).Rows("1:" & MergeWorkbook_data).Copy ThisWorkbook.Worksheets("merge").Range("a" & ThisWorkbook_data + 1)
        Next
    
           
    '結合するブックを閉じる
        Application.DisplayAlerts = False
            Workbooks(MergeWorkbook).Close
        Application.DisplayAlerts = True
    
'次のブックを探しに行く
        MergeWorkbook = Dir()
    Loop

サンプルはこちらです。
EX-ITサンプル フォルダ→ブック結合マクロ.xlsm

使えるデータをつくる・受け取ることが大事

今回のマクロ、便利ではあるのですが、使いたいものではありません。
そもそも複数のファイルに分ける必要があるのかということを考えなければいけません。

・月別のファイル→1枚にまとめられないか
・日別のファイル→1枚にまとめられないか
とちょっと工夫すれば、今回のマクロは必要なくなります。
(経費を担当者ごとに入力してもらいそれをまとめるマクロはお客様に導入しています。この場合はやむをえません)

今回、事例に使ったのは、ビットコイン取引所のコインチェック。
記事執筆当時は、取引履歴をダウンロードできるのですがこのように、月別です。

EX IT 5 7 17 33
それぞれをダウンロードして、結合して・・という手間がかかります。
しかも、ダウンロードファイルはZip(圧縮されていてダブルクリックしないと使えない)。
解凍は右クリックしてまとめてできるにはできますが、手間がかかるのも事実です。
なお、サイトの取引履歴からコピペしても、きれいなデータにならずコピペか別のマクロを使わざるを得ません。

その後使えるデータをつくることが大事なわけですし、そのデータを受け取ることが大事です。
マクロを使うと、きれいなデータを意識するようになります。
(「むむむ……」となることも増えますが)
きれいなデータ、使えるデータを意識することが、効率化の基本です。


【編集後記】

昨日は、恒例の自分の確定申告を。
(税理士業は個人事業主なので)
1時間ほど、とりまとめただけです。
今年は、医療費控除(出産)、ビットコインもあったので、より早めにとりかかっていました。
ふるさと納税は、ぎりぎりを攻めすぎましたが。

【昨日の1日1新】
※詳細は→「1日1新」

家族でアクアシティ神社

【昨日の娘日記】

はじめての正月。
が、我が家では、ふとひなまつりの話題も。
人形どうするか、考え中です。
大きなひな壇は置けないのですが。
昨日、トイザらスでみると、なかなかいい値段しました(10万)。

■スポンサードリンク
■井ノ上陽一のプロフィール
■スポンサードリンク



井ノ上陽一のVALU
■著書
【監修】十人十色の「ひとり税理士」という生き方
ひとり税理士のIT仕事術―ITに強くなれば、ひとり税理士の真価を発揮できる!!
フリーランスとひとり社長のための 経理をエクセルでトコトン楽にする本
新版 ひとり社長の経理の基本
毎日定時で帰っても給料が上がる時間のつかい方をお金のプロに聞いてみた!
『ひとり税理士の仕事術』
『フリーランスのための一生仕事に困らない本』
『社長!「経理」がわからないと、あなたの会社潰れますよ』
『そのまま使える経理&会計のためのExcel入門』