百聞は一見にしかず - 操作性

どんなに有効なプログラムでも、使いにくければ利用されません。プログラムを使いやすく作ることは重要なことですが、使いやすいプログラムを作るためには、本来の機能以外にプログラムの進行状況をユーザに逐一知らせる対話機能を作り込まなければなりませんが、ゼロからこの対話機能を作り上げるのは大変な労力が必要です。
Excelの自動化の良さは、この対話機能の作りこみにもExcelの持つ各種の対話機能を呼び出して使い、Windowsプログラムのような対話力の高い、使いやすいプログラムを容易に作ることが可能です。
この対話力の作り込みの例として処理の進捗状況を示すプログレス・バーの表示を前項の小計合計プログラムに組み込んだバージョンを紹介します。プログラムリストの中で黄色でハイライトした箇所(ブラウザはGoogle ChromeSafariを使用してください)がプログレス・バー表示のために追加したコードです。
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

プログラム実行の様子

動画でプログラム実行の速さを体感してください。
1 2

 

このサイトは個人生活を健やかに、愉しく、 企業活動を闊達にして、 持続可能な社会作りを目指します
Copyright © しなやか暮し研究所 2012 All Rights Reserved.