フォルダ内の複数のExcel経費精算書を集計・弥生会計へインポートするマクロ

フォルダ内にある経費精算書がある場合、手でコピーしていたら大変です。
こういったときにはマクロが便利です。

※パワポで作成

Excelで経費精算書をつくる

Excelで経費精算書をつくるなら、次のようなフォーマットがあります。

工夫しているところは、経費データを部分で、テーブル機能を使っている点です。
テーブル（Ctrl+T）を使えば、最後の行まで入力し（907）、Tabキーを押せば、

書式を維持したまま、次の行をつくることができます。
網掛け（青、白、青・・）のパターンもそのままです。

テーブルをクリックして、上部の［テーブルツール］の［集計行］にチェックを入れれば、集計行が追加されます。

SUMで計算するのと比べるとミスがありません。

Excel経費精算書に繰越マクロを入れる

この経費精算書は月ごとにシートを分けています。
シート名は、「2018年2月」といった形式で、これを集計マクロで使っているので、正しく入力しなければいけません。
「2018.2」
「２０１８年２月」
「h30.2」
「平成30年2月」
「2月」
「2」
じゃダメなわけです。

本来は、正しく入力できるよう人が気を付けるべきなのですが、なかなかそうもいきません。
そこで、人がやらなくていいようにします。
繰り越す場合、「繰越」のボタンを押せば、
このように、繰り越すようにマクロを組み込んでみましょう。

・シートをコピー
・セルA2の年月に1か月加算
・シート名を変更
・経費データをクリア
といったマクロです。

すでに繰越しているのに繰越ボタンを押してしまった時のためにエラー処理も入れています。

経費データをクリアするのは前の月のデータが残ってしまう可能性があるからです。

Sub kurikoshi()

    'シートをコピー
    ActiveSheet.Copy after:=Worksheets(Worksheets.Count)

    '年月を次の月に
    Range("a2") = DateAdd("m", 1, Range("a2"))


    On Error GoTo er  '→同じシート名があったら、エラー処理
    'シート名を変更
    ActiveSheet.Name = Year(Range("a2").Value) & "年" & Month(Range("a2").Value) & "月"


    '経費データをクリア
    Dim Max_row As Long

    Max_row = Range("a" & Rows.Count).End(xlUp).Row

    Rows("11:" & Max_row - 1).ClearContents

    Exit Sub
'エラーの場合の処理
er:
    MsgBox ("すでに翌月のシートがあります。")

    Application.DisplayAlerts = False
        ActiveSheet.Delete
    Application.DisplayAlerts = True
End Sub

さらにはシートを保護してもいいでしょう。

（お客様に提供しているファイルには保護をかけています）

その場合、繰越のマクロに、パスワードをいったん解除し、再度パスワードで保護をするという処理が必要です。

フォルダ内のExcel経費精算書を集計するマクロ

この経費精算書をプリントアウトして提出し、ハンコを押して・・とやると、紙を見ながら会計ソフトに入力しなければいけません。
データのままにしておき、それを集計したほうが効率的です。

とはいえ、複数のファイル、シートにあるデータを集計するのは、Excelの苦手とすること。
ここはマクロの出番です。

あらかじめ同じフォルダに入れておき、マクロで集計します。
ついでに会計ソフトへのインポートデータをつくるのが、このマクロです。

参照ボタンを押し、経費精算書ファイルが入っているフォルダを指定します。

次に年月を指定します。

この数値を読み取って、各経費精算書の該当月のシートを読み込んでいるわけです。

集計ボタンを押せば、

・フォルダにある経費精算書ファイルを開き

・該当月の経費データをコピーし、

・経費集計ファイルのシート「経費」に貼り付ける

といった処理をファイルの数だけ、つまり社員の分だけ繰り返します。

何人いても手間は同じです。
フォルダに入れ、ファイル名に「経費精算書」が入っていれば、粛々と処理してくれます。
こういったことを人がやっていたらキリがありません。
ただ、大事なのは、Excelに入力していただくこと。
これが手書きだとアウトですし、好き勝手なフォーマットだったらマクロもかないません。
お客様のケースでは、社長が先陣を切っていただいたので、このしくみを導入できました。
最初に導入したのは2013年です。

Excelで入力なんて・・・と思われるかもしれませんが、やってみると手書きで電卓たたくよりはるかに楽でミスもありません。

経費精算も仕事です。
手書きでささっとやったりレシートを経理に丸投げすることにより、経理担当者が苦労するということはあってはいけません。

全体の効率化を考えるべきです。

そして、集計したデータを

ピボットテーブルで集計しています。
ピボットテーブルでやっているのは、人が増減したときにも対応するためです。

ピボットテーブルは［更新］をしなければいけませんので、その部分もマクロでやっています。

そして、集めた経費データを有意義に使いたいものです。ここで、弥生会計のデータ形式に数式で連動させ、マクロで仕上げをして、CSVデータに保存しています。

マクロのコードを載せています。
アレンジして使ってみていただければ。

Sub keihi_folder()
'経費精算書ファイルが入っているフォルダを指定
    If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
        Range("l2").Value = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
    End If
End Sub
Sub keihi_merge()

    Dim Folder_path As String
    Folder_path = Range("l2").Value



'■経費集計ファイルの集計先シートを「経費」に指定
    Dim W_to As Worksheet
    Set W_to = Worksheets("経費")

'■シート「経費」のデータをいったんクリア
    W_to.Range("a2", "g2").ClearContents
    W_to.Range("a3", "ah" & Rows.Count).ClearContents

'■読み取る年月を指定
    Dim Data_month As String
    Data_month = Range("l5").Value & "年" & Range("l6").Value & "月"



'■経費精算書ファイルの読込開始行を指定
    Dim First_row As Long
    First_row = 11


'■フォルダから「経費精算書」という名前のファイルを検索して指定
    Dim Merge_book As String
    Merge_book = Dir(Folder_path & "\*経費精算書.xls*")


    Do Until Merge_book = ""

        '経費精算書ファイルを開く

        Workbooks.Open Filename:=Folder_path & "\" & Merge_book


        Dim W_from As Worksheet
        For Each W_from In Worksheets

            'もしシート名が該当月だったら
            If W_from.Name = Data_month Then


                '経費精算書ファイル（コピー元）
                Dim Max_row_from As Long
                Max_row_from = W_from.Range("b" & Rows.Count).End(xlUp).Row

                '経費集計ファイル（貼り付け先）
                Dim Max_row_to As Long
                Max_row_to = W_to.Range("a" & Rows.Count).End(xlUp).Row + 1

                '氏名をコピー
                W_from.Range("e4").Copy W_to.Range("f" & Max_row_to)

                '経費データをコピー
                W_from.Range("a" & First_row, "e" & Max_row_from - 1).Copy
                W_to.Range("a" & Max_row_to).PasteSpecial Paste:=xlPasteValues

            End If

        Next


        '経費精算書ファイルを閉じる
        Application.DisplayAlerts = False
        Workbooks(Merge_book).Close
        Application.DisplayAlerts = True

        Merge_book = Dir()
    Loop


    'ピボットテーブル用に、経費データの氏名データを埋める
    Dim keihi_Max_row
    keihi_Max_row = Worksheets("経費").Range("a" & Rows.Count).End(xlUp).Row

    Dim i
    For i = 2 To keihi_Max_row
        If Worksheets("経費").Range("f" & i).Value = "" Then
            Worksheets("経費").Range("f" & i).Value = Worksheets("経費").Range("f" & i - 1).Value
        End If


    Next

    Worksheets("集計").Select

    'ピボットテーブル更新
    ActiveSheet.PivotTables("p1").PivotCache.Refresh


'■弥生会計インポート用データを作成
    Worksheets("経費").Range("j2", "ah2").Copy Worksheets("経費").Range("j3", "ah" & keihi_Max_row)

'■新規ブックへコピー

    Worksheets("経費").Range("j2", "ah" & keihi_Max_row).Copy

    Workbooks.Add

    Range("a1").PasteSpecial Paste:=xlPasteValues
    Columns("d").NumberFormatLocal = "yyyy/mm/dd"

'■import.csvという名称で、ファイルを保存
    Application.DisplayAlerts = False

    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\import.csv", FileFormat:=xlCSV, Local:=True

    ActiveWorkbook.Close

    Application.DisplayAlerts = True



End Sub

経費精算システム・ソフトを入れればいいのでしょうが、そうもいかない場合も多いです。
高くて使い勝手の悪いものも多いですし。

Excel+マクロ+人のアイデアで、こういったものもつくれます。

---

【編集後記】

昨日は、朝、新宿に行き、発売されたSurface Book 2 15インチを入手。
セットアップして、午後はExcelマクロ プログラミング入門セミナーを開催しました。

次回は、5/11に開催します。

【昨日の1日1新】

※詳細は→「1日1新」ぬる燗佐藤

Surface Book 2 15インチ

【昨日の娘日記】

新年度の最初の週、新しい先生や新入児に戸惑っていましたが、だいぶ慣れたようです。
昨日は、送っていったとき、泣かずにバイバイしてました。