1記事1ツールをVBAで作るサンプルシリーズです。
少しでもわかりやすく、直感的にイメージ出来るように簡単なコードばかり使用しています。
今回は「決まった形のファイルを読み込んで、売上を集計をして、別ファイルに集計結果を出力する」というツールを作成します。
基本的には、すでに記事で紹介している内容を使用したコードで作りたいと思います。
今回は定型ファイルを読み取って、集計した結果を新しいファイルに出力して、別名保存するサンプルツールです。
VBAの構文は検索すると非常に多くの情報が得られますし、書籍も多いです。
ですが、勉強はしてもツールを作るとなると、どうしたら良いかわからない方が多いのではないかと思います。
実際のツールを作る一連の方法を1記事にまとめてみましたので、ツールの作り方がイメージできるかと思います。
高速版を作成したので「ツール作成サンプル 売上を自動集計する(高速編)」もご覧ください。
1.ツールを作る上で大事なこと
ツールを作るには、ある程度ツールの設計を考える必要があります。
簡単なツールであれば設計を飛ばして作成しても問題ありませんが、複雑なツールになるほど設計は大事になります。
そして、ツールは1つ1つのパーツを作り、組み立てていくことで出来上がります。
各パーツを作るときに、必ずいくつかの選択肢が発生しますので、作りたいツールに合わせた選択をしていきます。
選んだ選択によって、必ず新しい「運用ルール」が発生します。
「新しい運用ルール？」がなぜ発生する理由なども読み進めて頂けると理解できると思います。
サンプルはあくまで一例ですので、他にも方法はたくさんあります。
2.今回使うサンプルデータ
今回は次のような注文日、注文番号、商品、単価、販売数量、売上金額の1か月分のデータ300行を使用します。
3.ツールの最終アウトプットと設計(プロセス)を考える
今回は「決まった形のファイルを読み込んで、集計をして、別ファイルに集計結果を出力する」というツールを作成します。
いきなり完成系のツールを作り始めるのではなく、まずは最終的にどのようなアウトプットを目標としているかを考えます。
そして、そのアウトプットを実現するための設計(プロセス)を考えたいと思います。
最終的なアウトプット
今回は「日別」、「商品別」の2種類の売上集計をしたいと思います。
売上と一緒に「販売数量」も一緒に集計したいと思います。
全体の設計
大まかで構いませんので全体設計を考えます。
最初はこのくらいシンプルで大丈夫です。
全体設計の各パーツをもう少し具体的に考えてみる
ここから各パーツについてもう少し具体的に考えていきます。
各パーツをどのように作るかで、先ほど記載した「新しいルール」が発生します。
ファイルを読み込む
ファイルの読み込み方にはいくつか方法がありますが、まずどんなツールを作るかで選択する方法が変わってきます。
「決まった時間に自動で集計」させるのか、「ユーザーが集計したい時に集計」するのか等です。
上記の場合次のような選択肢とルールが発生します。
例えば「決まった時間に自動で集計」するツールであれば、次のようなルールが発生します。
集計時間前に決まったフォルダにファイルを格納する。
このルールを適用させると、決まった時間になると指定したフォルダにあるファイルを読み込んで
自動で集計するツールが作れます。
もう一つの例で「ユーザーが集計したい時に集計」するツールであれば、ダイアログを開くボタンを作り、ユーザーに任意にファイルを選択させる方法があります。
この場合は「ユーザーがファイルを選択する」というルールが発生します。
今回はユーザーにファイルを選択してもらうツールを作ります。
集計する
「集計する」パーツは、十人十色と言っても良いくらい、方法が様々だと思います。
ここではある程度方法を決めて、プロセスを組み立てたいと思います。
2項のサンプルデータを集計しますが、どこまで汎用性を高めるかでコードも変化します。
慣れてくると最初から汎用性の高い動的なコードを書けますが、慣れるまでは一度静的なコードを書いてから動的に書き換えていくのをお勧めします。
今回は次の表のAを作成します。
データ量が増えたり処理速度を早くしたい場合にはBの様に配列を使って集計する方法などもあります。
別ファイルに出力する
読み込み→集計の次は別ファイルに出力するパーツです。
ここでもいくつか選択肢があります。
「自動で指定したフォルダに保存する」、「ユーザーに保存場所もファイル名も指定してもらう」などです。
今回は「ユーザーに保存場所もファイル名も指定してもらう」を選択します。
4.コードを書く
最終的なアウトプットと設計(プロセス)が出来たので、次は各パーツのコードを書いていきます。
ファイルを読み込むコード
次のコードはダイアログを開いて、選択されたファイルを読み込みます。
ユーザーに選択させるリスクとして間違ったファイルを選択する可能性もありますので、念のため項目が形式と一致しているかの判定をしています。
ダイアログを開く方法は「ダイアログでファイルを指定してファイルを開く」をご覧下さい。
ファイルを読み込む方法は「指定したファイルを読み込む」をご覧ください。
Sub Sample1()
Dim FilePass As Variant
Dim FileName As String
Dim ShCount As Long
ShCount = ThisWorkbook.Worksheets.Count 'VBAの書かれたファイルのシート数
'ダイアログを開いてファイルを指定
FilePass = Application.GetOpenFilename("Excelブック,*.xlsx,Excelマクロ,*.xlsm,テキスト,*.txt")
If FilePass <> "False" Then
FileName = Dir(FilePass) 'ファイル名を取得
Workbooks.Open FilePass 'ファイルを開く
Worksheets(1).Copy after:=ThisWorkbook.Worksheets(ShCount) '一番最後に追加
Workbooks(FileName).Close savechanges:=False
ActiveSheet.Name = "データ" '読み込んだシート名を変更する
'データをチェックする
With ActiveSheet
'項目が注文日/注文番号/商品/単価/販売数量/売上金額であることが条件
If Not (.Cells(1, 1) = "注文日" And _
.Cells(1, 2) = "注文番号" And _
.Cells(1, 3) = "商品" And _
.Cells(1, 4) = "単価" And _
.Cells(1, 5) = "販売数量" And _
.Cells(1, 6) = "売上金額") Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
MsgBox "集計できないデータ形式です。"
End
End If
End With
Else
End
End If
End Sub集計するコード
次のコードは読み込んだデータを集計します。
今回はわかりやすく集計部分を1プロシージャにまとめて、上から順にプロセス通りに書いています。
流れとしてはアウトプット用のリスト作成から集計、最後に装飾となっています。
リスト作成のDictionaryについては「Dictionaryの使い方」をご覧ください。
実際には計算部分など、さらに「ユーザー定義関数(Functionプロシージャ)」で分割すると、複雑なツールを作る際に可読性が上がります。
Sub Sample2()
Dim MaxRow1 As Long
Dim MaxRow2 As Long
Dim i As Long
Dim ImpWS As Worksheet
Dim OutWS As Worksheet
Dim DateDic As Object
Dim ItemDic As Object
Dim myVal As Variant
Dim DateKey As Variant
Dim ItemKey As Variant
Const title1 As String = "日別売上"
Const title2 As String = "商品別売上"
Application.ScreenUpdating = False
Set DateDic = CreateObject("Scripting.Dictionary") 'Dictionaryをセット
Set ItemDic = CreateObject("Scripting.Dictionary") 'Dictionaryをセット
Set ImpWS = Worksheets("データ")
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "集計結果"
Set OutWS = Worksheets("集計結果")
With ImpWS
MaxRow1 = .Cells(Rows.Count, 1).End(xlUp).Row
'■■日付のリスト作成■■
For i = 2 To MaxRow1
myVal = .Cells(i, 1)
If Not DateDic.exists(myVal) Then
DateDic.Add myVal, ""
End If
Next i
DateKey = DateDic.keys
'■■商品のリスト作成■■
For i = 2 To MaxRow1
myVal = .Cells(i, 3)
If Not ItemDic.exists(myVal) Then
ItemDic.Add myVal, ""
End If
Next i
ItemKey = ItemDic.keys
End With
With OutWS
'■■アウトプット作成■■
.Cells(2, 2) = title1
.Cells(3, 2) = ImpWS.Cells(1, 1)
.Cells(3, 3) = ImpWS.Cells(1, 5)
.Cells(3, 4) = ImpWS.Cells(1, 6)
.Cells(2, 6) = title2
.Cells(3, 6) = ImpWS.Cells(1, 3)
.Cells(3, 7) = ImpWS.Cells(1, 5)
.Cells(3, 8) = ImpWS.Cells(1, 6)
For i = 0 To UBound(DateKey)
.Cells(i + 4, 2) = Format(DateKey(i), "yyyy/mm/dd")
Next i
.Cells(i + 4, 2) = "総計"
For i = 0 To UBound(ItemKey)
.Cells(i + 4, 6) = ItemKey(i)
Next i
.Cells(i + 4, 6) = "総計"
'■■集計する■■
MaxRow2 = .Cells(Rows.Count, 2).End(xlUp).Row
For i = 4 To MaxRow2 - 1
.Cells(i, 3) = Application.WorksheetFunction.SumIf _
(Range(ImpWS.Cells(2, 1), ImpWS.Cells(MaxRow1, 1)), .Cells(i, 2), Range(ImpWS.Cells(2, 5), ImpWS.Cells(MaxRow1, 5)))
.Cells(i, 4) = Application.WorksheetFunction.SumIf _
(Range(ImpWS.Cells(2, 1), ImpWS.Cells(MaxRow1, 1)), .Cells(i, 2), Range(ImpWS.Cells(2, 6), ImpWS.Cells(MaxRow1, 6)))
Next i
.Cells(MaxRow2, 3) = Application.WorksheetFunction.Sum(Range(.Cells(4, 3), .Cells(MaxRow2 - 1, 3)))
.Cells(MaxRow2, 4) = Application.WorksheetFunction.Sum(Range(.Cells(4, 4), .Cells(MaxRow2 - 1, 4)))
'■■装飾する■■
Range(.Cells(3, 2), .Cells(MaxRow2, 4)).Borders.LineStyle = xlContinuous '罫線
Range(.Cells(3, 2), .Cells(3, 4)).Interior.Color = RGB(64, 64, 64) '背景色
Range(.Cells(3, 2), .Cells(3, 4)).Font.Color = RGB(255, 255, 255) '文字色
Range(.Cells(3, 2), .Cells(3, 4)).HorizontalAlignment = xlCenter '中央揃え
'■■集計する■■
MaxRow2 = .Cells(Rows.Count, 6).End(xlUp).Row
For i = 4 To MaxRow2 - 1
.Cells(i, 7) = Application.WorksheetFunction.SumIf _
(Range(ImpWS.Cells(2, 3), ImpWS.Cells(MaxRow1, 3)), .Cells(i, 6), Range(ImpWS.Cells(2, 5), ImpWS.Cells(MaxRow1, 5)))
.Cells(i, 8) = Application.WorksheetFunction.SumIf _
(Range(ImpWS.Cells(2, 3), ImpWS.Cells(MaxRow1, 3)), .Cells(i, 6), Range(ImpWS.Cells(2, 6), ImpWS.Cells(MaxRow1, 6)))
Next i
.Cells(MaxRow2, 7) = Application.WorksheetFunction.Sum(Range(.Cells(4, 7), .Cells(MaxRow2 - 1, 7)))
.Cells(MaxRow2, 8) = Application.WorksheetFunction.Sum(Range(.Cells(4, 8), .Cells(MaxRow2 - 1, 8)))
'■■装飾する■■
Range(.Cells(3, 6), .Cells(MaxRow2, 8)).Borders.LineStyle = xlContinuous '罫線
Range(.Cells(3, 6), .Cells(3, 8)).Interior.Color = RGB(64, 64, 64) '背景色
Range(.Cells(3, 6), .Cells(3, 8)).Font.Color = RGB(255, 255, 255) '文字色
Range(.Cells(3, 6), .Cells(3, 8)).HorizontalAlignment = xlCenter '中央揃え
.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub集計結果を出力するコード
集計結果が出来たら、ダイアログを開いてファイル名を指定してもらうと、別ファイルとして保存されます。
予めダイアログに「集計結果」というファイル名を入力しています。
Sub Sample3()
Dim ImpWS As Worksheet
Dim OutWS As Worksheet
Dim FileName As String
Set ImpWS = Worksheets("データ")
Set OutWS = Worksheets("集計結果")
OutWS.Move
FileName = Application.GetSaveAsFilename("集計結果", _
"Excel2013,*.xlsx,Excel2003,*.xls,Excel.csv,*.csv", , "Excelブックを保存")
If StrConv(FileName, vbUpperCase) <> "FALSE" Then
On Error Resume Next
ActiveWorkbook.SaveAs FileName:=FileName
ActiveWorkbook.Close
End If
ThisWorkbook.Activate
Application.DisplayAlerts = False
ImpWS.Delete
Application.DisplayAlerts = True
End Subマクロを呼び出すボタンを作成
VBEからコードを呼び出すのは不便なので、オートシェイプで図を挿入し、マクロの登録をすることでボタンを押すと上記で作成したコードが呼び出されるようにしました。
Sub MAIN_Click()
Call Sample1
Call Sample2
Call Sample3
End Sub5.サンプルファイルダウンロード
今回使用したツールのファイルと読み込む用に作成したサンプルファイルをこちらからダウンロードできます。
6.まとめ
今回作成したツールは、指定したデータを読み込み、集計して、別ファイルに出力するという非常に多用する場面が多いツールではないかと思います。
汎用性を高めたり、処理速度を早くしたり工夫すると、それだけ複雑な作りになりますが、この様に順序立てて作ってみるとそんなに難しくありません。
「作ること」に慣れてきたら、少しずつ工夫し可読性や処理速度などを、意識したツールを作り始めると良いかもしれません。
