どんなに有効なプログラムでも、使いにくければ利用されません。プログラムを使いやすく作ることは重要なことですが、使いやすいプログラムを作るためには、本来の機能以外にプログラムの進行状況をユーザに逐一知らせる対話機能を作り込まなければなりませんが、ゼロからこの対話機能を作り上げるのは大変な労力が必要です。
Excelの自動化の良さは、この対話機能の作りこみにもExcelの持つ各種の対話機能を呼び出して使い、
Windowsプログラムのような対話力の高い、使いやすいプログラムを容易に作ることが可能です。
この対話力の作り込みの例として処理の進捗状況を示すプログレス・バーの表示を前項の小計合計プログラムに組み込んだバージョンを紹介します。プログラムリストの中で黄色でハイライトした箇所(ブラウザは
Google Chromeか
Safariを使用してください)がプログレス・バー表示のために追加したコードです。
Excelが公開しているオブジェクト(対象)に、メソッド(動作)を指定するだけなので、わずかなコードの追加で、高度な対話機能を実現できます。
Sub 小計集計書込みグループ化進捗表示付き()
Dim 入力File As String
Dim 入力Tab As String
Dim myRange As AutoFilter
Dim RowMin As Long
Dim RowMax As Long
Dim J As Long
Dim JJ As Long
Const MaxBar As Integer = 26
Dim ws As Worksheet
Dim flag As Boolean
Dim 合計コード As Integer
Dim 小計コード As Integer
Dim 小計A As Double
Dim 小計B As Double
Dim 合計A As Double
Dim 合計B As Double
Dim 値A列 As Integer
Dim 値B列 As Integer
Dim 小計キー列 As Integer
Dim 合計キー列 As Integer
Dim 小計キー列文字 As String
Dim 合計キー列文字 As String
Dim 列Max As String
Dim GroupStart As Long
Dim TopGroupStart As Long
Dim GroupEnd As Long
Dim TopGroupEnd As Long
Dim 合計キーセル As Variant
Dim 小計キーセル As Variant
入力ファイル = "小計合計サンプル.xlsx"
入力Tab = "月別売上原価"
値A列 = 3 '集計する値A列番号
値B列 = 4 '集計する値B列番号
小計キー列 = 2 '小計キー列番号
合計キー列 = 1 '合計キー列番号
小計キー列文字 = "B" '小計キー列名
合計キー列文字 = "A" '合計キー列名
RowMin = 2
列Max = "I"
'Application.ScreenUpdating = False
UserForm111.Caption = "月別、品目別集計" 'ユーザフォームの初期化
UserForm111.Label2.Caption = "" '表示クリア
UserForm111.Show vbModeless
Windows(入力ファイル).Activate
Sheets(入力Tab).Select
'入力Fileの最大行検出
RowMax = Cells(Rows.Count, 1).End(xlUp).Row
'ユーザフォームの初期化
UserForm111.ProgressBar1.Min = 0
UserForm111.ProgressBar1.Max = MaxBar
UserForm111.Label1.Caption = 入力Tab & "データ ソート"
UserForm111.ProgressBar1.Value = 0
UserForm111.Repaint
'合計(C)_小計(A)をキーに昇順ソート
ActiveWorkbook.Worksheets(入力Tab).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(入力Tab).Sort.SortFields.Add Key:=Range( _
合計キー列文字 & RowMin & ":" & 合計キー列文字 & RowMax), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(入力Tab).Sort.SortFields.Add Key:=Range( _
小計キー列文字 & RowMin & ":" & 小計キー列文字 & RowMax), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(入力Tab).Sort
.SetRange Range("A1:" & 列Max & RowMax)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'データを順に読みながら排出地、種類コードごとの集計を書込む
小計A = 0
小計B = 0
合計A = 0
合計B = 0
GroupStart = RowMin
TopGroupStart = RowMin
J = 1
'A列値、B列値を読んで、小計、合計に加算
Do While J <= RowMax
J = J + 1
小計キーセル = Cells(J, 小計キー列).Value
合計キーセル = Cells(J, 合計キー列).Value
小計A = 小計A + Cells(J, 値A列).Value
小計B = 小計B + Cells(J, 値B列).Value
合計A = 合計A + Cells(J, 値A列).Value
合計B = 合計B + Cells(J, 値B列).Value
If 小計キーセル <> Cells(J + 1, 小計キー列).Value Or J = RowMax Then
'次のレコードで小計種類が変わる 小計種類グループを終了し、1行追加して小計を書込む
GroupEnd = J
Rows(J + 1).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Cells(J + 1, 小計キー列).Value = 小計キーセル
Cells(J + 1, 小計キー列 + 1).Value = Cells(J, 小計キー列 + 1).Value & " 小計"
Cells(J + 1, 値A列).Value = 小計A
Cells(J + 1, 値B列).Value = 小計B
'ここまでをグループ化(レベル2)
Rows(GroupStart & ":" & GroupEnd).Select
Selection.Rows.Group
ActiveSheet.Outline.ShowLevels RowLevels:=1
小計A = 0
小計B = 0
RowMax = RowMax + 1
J = J + 1
GroupStart = J + 1
End If
If 合計キーセル <> Cells(J + 1, 合計キー列).Value Or J = RowMax Then
'次のレコードで合計種類が変わる 合計種類グループを終了し、1行追加して小計を書込む
If 小計A <> 0 Then
'直前に小計種類の区切りが来ていない(次の集計種類の小計種類と現レコードの小計種類が同じ)
'まず小計種類の区切りを付ける
GroupEnd = J
Rows(J + 1).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Cells(J + 1, 小計キー列).Value = 小計キーセル & " 小計"
Cells(J + 1, 値A列).Value = 小計A
Cells(J + 1, 値B列).Value = 小計B
'ここまでをグループ化(レベル1)
Rows(GroupStart & ":" & GroupEnd).Select
Selection.Rows.Group
ActiveSheet.Outline.ShowLevels RowLevels:=1
小計A = 0
小計B = 0
RowMax = RowMax + 1
J = J + 1
End If
'合計種類の区切りをつける 1行追加して合計を書込む
TopGroupEnd = J
Rows(J + 1).Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Cells(J + 1, 合計キー列).Value = 合計キーセル
Cells(J + 1, 小計キー列).Value = "合計"
Cells(J + 1, 値A列).Value = 合計A
Cells(J + 1, 値B列).Value = 合計B
Rows(TopGroupStart & ":" & TopGroupEnd).Select
Selection.Rows.Group
ActiveSheet.Outline.ShowLevels RowLevels:=1
合計A = 0
合計B = 0
RowMax = RowMax + 1
J = J + 1
GroupStart = J + 1
TopGroupStart = GroupStart
End If
'プログレスバーの値更新
JJ = J - 1
UserForm111.Label2.Caption = JJ
UserForm111.ProgressBar1.Value = (MaxBar * JJ) / RowMax
UserForm111.Repaint '再表示
Loop
Unload UserForm111 'ユーザフォームの終了
MsgBox "小計、合計処理を終了しました。"
Application.ScreenUpdating = True
Exit Sub
Errorhandler:
End Sub
プログラム実行の様子
動画でプログラム実行の速さを体感してください。