立て直せ、人生。

人生行き当たりばったりなアラサーが、無事にアラフィフになれるように頑張らないブログ

エクセル至上主義社会の中心で複数エクセルの集計処理を叫ぶ(VBAマクロ書いてみた)

スポンサーリンク

エクセルが嫌いだ。けれど世の中にはどうしたって抗えない圧力みたいなもので満ちている。

世界はエクセルで満たされている。申請書はエクセル、見積書はエクセル、図版もエクセル……。誰でもどこでも扱える、最強互換性のポータビリティ溢れるファイルだと信じて疑わない人たちは、日々エクセルで生活をしている。

ぼくには無理だ。

だから、なるべくお近づきにならないように生活していたが、それでも触れなければならないことだってある。 ぼくは、調査担当者から集められてきた結果エクセルファイルを前に、小さな殺意を抱いていた。

だから、ぼくは自動化を目指した。他の人々の個別の調査結果エクセルファイルを集約し、集計するエクセルを。

エクセルは、ひとつのファイルにまとまっていれば扱いがたやすい。セル参照シート参照などで容易に値が取得できる。けれど、別ファイルのエクセルを参照しようとした途端その前提は崩れる。

とてもつらい。

つらいからぼくはエクセルマクロの世界へと旅立った。

やりたいこと

個別の担当者の人が作ってくれたエクセルファイルには、品名とその品名に付随する情報(壊れている、使えるなど)が一覧で列挙されている。

私は、その一覧に乗っている品がいくつあるか?とか、壊れているものがいくつあるか?などを集計したい。 ひとつのファイルにまとまっていれば、単純に数式を埋め込むだけでよい。しかし、先述のとおり、担当者ごとに別々のファイルになっており、それらを横断的に集計する必要がある。

これまでは、更新がかかるたびに集計用エクセルにシートをコピーしていた。とてもつらい。マウスを持つ右手が痛い。

このため、ぼくが実装したのは、沢山のエクセルファイルからシートをコピーし、1つのエクセルファイルに集約する機能だった。

書いたエクセルマクロ

簡単な仕様は次のとおり。

  • 個別ファイルのシートを収集し、ひとつのエクセルファイルにまとめられるようにする
    • 担当者ごとに個別のファイルを更新するため
  • 集計対象のエクセルファイルは、1ファイル1シートのみ存在している
  • カラムの位置などは、すべてのエクセルファイルで統一されている

上記をうけ、実装した機能としては次のとおり。実際の集計処理は、エクセルの関数を使って行っているので、マクロで実装するのは、別エクセルを1ファイルに集約してくれる機能だけでよい。

  • エクセルのファイルチェック
    • 1ファイルに1シートしかないことを確認
  • 収集
    • 各エクセルファイルからシートをコピー、集約
    • シート名は、収集対象のエクセルファイルのファイル名より取得
  • 削除
    • コピーしてきたシートを削除する
      • 操作用シート(master)と、集計用の数式が入ったシート(template)と、コピペして結果保存用のシート(result)以外は全部削除

自動化した効果

VBAは初めて書く。だから、実装自体に半日強も掛かってしまった。ただ、効果はてきめんで、集計操作を他の人に任せやすくなったし、コピー漏れなどのミスが無くなった。

本当であれば、データベースを使ったり、csvで結果をもらってプログラム処理するほうが自由度も高いし、機能追加などの改造もしやすい。 けれど、他の人に任せる……つまり再現性を持たせる以上、Excelでやるのがベストだと判断した*1

で、これを作ったあとに言われたことば。

「それ、MS-Accessでできるよ?ExcelもDBみたいに扱えるよ?エクセルの関数で頑張らなくてもいいんだよ?」*2

その日、ぼくは悲しくなって早上がりをした。

みんなどうしてますか

こういう問題、みんな結構ぶつかると思う。他の人たちはどうしているんだろう?という疑問がわく。

Excelで人力で頑張ってるよ、自動化したよ(ぼくはこれ)、MS-Accessでやっているよ、ツール書いた……などなど、色々あると思うけれど、純粋に他の人たちはどう解決しているのか、興味がある。

なお、ちゃんとしたツール化をする、という案もある。けれど、「この案件では繰り返し使うけど、汎用性がない」などという状況だと、やっぱり現場でなんとかしちゃうしかないっていうのが個人的な感想。

関連エントリ

ぼくがExcel嫌いっていうエントリ。

rebuild-life.hatenablog.jp

おまけ:作成したマクロ

以下には、実際に作成したマクロを掲載する。

チェック用

Sub CountSheet()
    Dim basePath As String
    
    Dim dlg As FileDialog
    Dim fold_path As String
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)

    ' キャンセルボタンクリック時にマクロを終了
    If dlg.Show = False Then Exit Sub

    'フォルダーのフルパスを変数に格納
    basePath = dlg.SelectedItems(1) & "\"
    buf = Dir(basePath & "*.xlsx")
    Dim errFileArray() As String
    
    ' Dim strSeet
    
    Do While buf <> ""
        cnt = cnt + 1
        
        Dim bookPath As String
        bookPath = basePath & buf
        
        ' worksheet open
        Set wb = Workbooks.Open(bookPath)
        wsCnt = wb.Worksheets.Count
        
        ' worksheet が2枚以上あった場合
        If wsCnt > 1 Then
            MsgBox "複数シートがあるファイルがあります。" & buf
            Exit Do
        End If
        wb.Close SaveChanges:=False
        
        ' next
        buf = Dir()
    Loop
    MsgBox "シート数チェック完了。問題なし。すべて1シートのみのファイルです。"
End Sub

別エクセルのファイルを1ファイルに集めてくる

Sub CorrectSheet()
    Dim basePath As String
    
    Dim dlg As FileDialog
    Dim fold_path As String
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)

    ' キャンセルボタンクリック時にマクロを終了
    If dlg.Show = False Then Exit Sub

    'フォルダーのフルパスを変数に格納
    basePath = dlg.SelectedItems(1) & "\"
    
    ' bookpath から個別のファイルの位置を特定
    buf = Dir(basePath & "*.xlsx")
    
    Dim cnt As Integer: cnt = 0
    Do While buf <> ""
        cnt = cnt + 1
        Dim bookPath As String
        bookPath = basePath & buf

        ' worksheet open
        ' - 新しいシートは、最後のシートに引っ付ける
        Debug.Print bookPath
        Set wb = Workbooks.Open(bookPath)
        wb.Worksheets(1).Copy After:= _
            ThisWorkbook.Sheets(ThisWorkbook.Worksheets.Count)
        ' worksheet close
        wb.Close SaveChanges:=False
        
        ' change sheet name
        ' - シート名は、拡張子を除いたファイル名
        nameArray = Split(buf, ".")
        newSheetName = nameArray(0)
        ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = newSheetName
        
        ' next
        buf = Dir()
    Loop
End Sub

不要シート削除

Sub DeleteSheet()

    ' 削除確認ダイアログ
    Dim ret As Integer
    ret = MsgBox("main,master,resultシート以外をすべて削除します", vbYesNo + vbQuestion, "確認")
    If ret = vbNo Then
        MsgBox "処理を中断します"
        Exit Sub
    End If
        
    ' 実際の削除処理
    For Each mySheet In ThisWorkbook.Worksheets
        If Not (mySheet.Name = "main" Or mySheet.Name = "master" Or mySheet.Name = "template" Or mySheet.Name = "result") Then
            ' 収集したシートをすべて削除
            ' - 削除アラートを一時的にOffして、再度On
            Application.DisplayAlerts = False
            ThisWorkbook.Worksheets(mySheet.Index).Delete
            Application.DisplayAlerts = True
        End If
    Next
End Sub

*1:以前、プログラム作って処理したら、確認ができない……としょんぼりされてしまったことがある

*2:MS-Accessのライセンスは、必要な数だけあった