こんにちは！Excel VBAを使ってデータ整理の自動化に挑戦してみませんか？
今回は過去に紹介したコードを実際に利用したうえでさらに追加機能を付加したコードを紹介します。これにより実際に私の紹介したコードの利用イメージを持っていただけるようになります。
実現する機能は以下のようなものです。
- 開始終了データから各工程の所要時間を自動計算 【過去紹介記事へ】
- 大量のデータを品種別にワークシートに自動分類 【過去紹介記事へ】
- 各品種毎の工程所要時間に対して基本統計量を自動計算する 【本記事での追加機能】
このコードを使うことで、手作業の煩わしさから解放され、データ整理の効率が大幅にアップします。さらに、手動操作によるミスも防ぐことができるので、データ処理がよりスマートに行えます。
本記事は、VBAコードを直接コピーして使用したい方や、VBAの基本を理解している方、または他者のコードを参考にしたい方に向けて記載しています。コードの詳細な解説は割愛していますが、実際に試してみることでその効果を実感してください！
使用するデータリスト
まず使用するデータリストについて解説します。データリストは「データシート」のワークシート上に下図の構成でＡ１セルより作成しています。今回はデータを1000行分作成しました。データの種類として品種を10種類、工程を4種類用意しました。
ＶＢＡの実行結果
VBAを実行すると、下図のように所要時間を計算したうえで品種毎に分類されたデータシートと、見出しに基本統計量が表示されます。本コードでは見出しの並び替えや罫線は実行していませんが、必要に応じて実施しても良いと思います。
コード★★★（コピーはここ）★★★
コードの全文は左の三角マークをクリックしてください。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 |
Sub Sample10() ' グレード名、グレード、データの配列を定義 Dim Category_Name As Variant, Category As Variant, Data_C As Variant Dim Category_List As Object ' グレード名を保持する辞書 Dim wsData As Worksheet, wsCategory As Worksheet ' データシートとグレードシートの参照 Dim LAST_R As Long, LAST_C As Long ' データ範囲の最終行と最終列 ' データシートの参照を設定 Set wsData = Worksheets("データシート") ' データシートの最終列行を取得 LAST_C = wsData.Cells(1, Columns.Count).End(xlToLeft).Column LAST_R = wsData.Cells(Rows.Count, 2).End(xlUp).Row '所要時間計算 Call Sample08(LAST_R) ' グレードリストを取得 Call GetCategory(Category, Category_List, wsData, LAST_R) ' グレード名称を配列に変換 Category_Name = Category_List.Keys ' データを配列に読み込む（2行目以降のデータ範囲） Data_C = wsData.Range(wsData.Cells(2, 2), wsData.Cells(LAST_R, LAST_C)).Value ' 各グレードごとに処理 For Each Category In Category_Name Set wsCategory = Nothing ' ワークシート参照のリセット ' グレード用のワークシートを作成または取得 Call MakeWorkSheet(Category, wsCategory) ' データを各グレードのワークシートに貼り付け Call DataPaste(Category, wsCategory, LAST_C, Data_C) Next Category Call CreateSummarySheet(wsData, LAST_C, LAST_R, Data_C, Category_List) End Sub Sub GetCategory(ByRef Category As Variant, _ ByRef Category_List As Object, _ ByRef wsData As Worksheet, _ ByVal LAST_R As Long) ' グレード名称リストの作成（重複を排除） Dim i As Long ' グレード名を保持する辞書を作成 Set Category_List = CreateObject("Scripting.Dictionary") ' 各行のグレードを辞書に追加（重複を防ぐ） For i = 2 To LAST_R Category = wsData.Cells(i, 2).Value If Not Category_List.exists(Category) Then Category_List.Add Category, Nothing End If Next i End Sub Sub MakeWorkSheet(ByVal Category As Variant, _ ByRef wsCategory As Worksheet) ' グレード用のワークシートの存在確認と新規作成 On Error Resume Next ' エラーを無視して既存のワークシートを探す Set wsCategory = Worksheets(Category) On Error GoTo 0 ' エラー処理をリセット ' ワークシートが存在しない場合は新規作成 If wsCategory Is Nothing Then Set wsCategory = Worksheets.Add(After:=Worksheets(Worksheets.Count)) wsCategory.Name = Category ' ワークシート名をグレード名に設定 Else ' 既存のワークシートの場合、必要に応じて内容をクリアなどの処理を追加 End If ' ワークシートのフォーマットを設定 Call FormatChange(wsCategory) End Sub Sub DataPaste(ByVal Category As Variant, _ ByVal wsCategory As Worksheet, _ ByVal LAST_C As Long, _ ByVal Data_C As Variant) ' グレードに対応する行をフィルタリングして貼り付け Dim RowCounter As Long ' 貼り付け行のカウンタ Dim i As Long ' 初期貼り付け行位置 RowCounter = 0 ' 配列から該当するグレードの行をフィルタしてワークシートに貼り付け For i = 1 To UBound(Data_C, 1) If Data_C(i, 1) = Category Then wsCategory.Cells(RowCounter + 2, 2).Resize(1, LAST_C - 1).Value = _ Application.Index(Data_C, i, 0) ' 該当行を貼り付け RowCounter = RowCounter + 1 ' 次の行に移動 End If Next i End Sub Sub FormatChange(ByVal PasteDestination As Worksheet) Dim wsSorce As Worksheet Dim rngTable As Range ' データシートの参照を取得 Set wsSorce = Worksheets("データシート") ' データシートのA列をコピーして、各グレードシートのA列に貼り付け wsSorce.Columns("A:A").Copy Destination:=PasteDestination.Columns("A:A") ' データシートの1行目をコピーして、各グレードシートの1行目に貼り付け wsSorce.Rows("1:1").Copy Destination:=PasteDestination.Rows("1:1") ' シートのA1を起点として表全体の範囲を動的に取得 Set rngTable = PasteDestination.Range("A1").CurrentRegion ' 表全体に枠線を設定 With rngTable.Borders .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With End Sub Sub Sample08(ByVal LastRow As Long) ' 設定セクション（セル参照で設定） Dim DataStartCell As Range: Set DataStartCell = Range("B2") ' データの開始セル Dim StartHourCell As Range: Set StartHourCell = Range("D2") ' 開始時のセル Dim StartMinuteCell As Range: Set StartMinuteCell = Range("E2") ' 開始分のセル Dim EndHourCell As Range: Set EndHourCell = Range("F2") ' 終了時のセル Dim EndMinuteCell As Range: Set EndMinuteCell = Range("G2") ' 終了分のセル Dim ResultCell As Range: Set ResultCell = Range("H2") ' 結果の出力セル ' 変数の宣言 Dim NN As Long ', LastRow As Long Dim HourDiff As Double, MinuteDiff As Double Dim Results() As Variant ' データの最終行を取得 'LastRow = StartMinuteCell.End(xlDown).Row ' 結果を格納する配列を初期化 ReDim Results(DataStartCell.Row To LastRow) For NN = DataStartCell.Row To LastRow ' 時間差の計算（終了時 - 開始時） HourDiff = Cells(NN, EndHourCell.Column).Value - Cells(NN, StartHourCell.Column).Value MinuteDiff = Cells(NN, EndMinuteCell.Column).Value - Cells(NN, StartMinuteCell.Column).Value ' 時間差が負の場合は24時間を加算 If HourDiff < 0 Or (HourDiff = 0 And MinuteDiff < 0) Then HourDiff = HourDiff + 24 ' 配列に合計時間を格納 Results(NN) = TimeSerial(HourDiff, MinuteDiff, 0) Next NN ' 一括でセルに書き込む ResultCell.Resize(LastRow - DataStartCell.Row + 1).Value = Application.Transpose(Results) End Sub Sub CreateSummarySheet(ByVal wsData As Worksheet, _ ByVal LAST_C As Long, _ ByVal LAST_R As Long, _ ByVal Data_C As Variant, _ ByVal Category_List As Object) Dim wsSummary As Worksheet Dim Category As Variant, Process As Variant Dim i As Long, j As Long, SummaryRow As Long Dim Values() As Double Dim Results As Collection Dim ProcessCategory As String Dim ProcessCategory_List As Object Dim CategorySplit As Variant ' 見出しシートの作成または取得 On Error Resume Next Set wsSummary = Worksheets("見出し") If wsSummary Is Nothing Then Set wsSummary = Worksheets.Add(After:=Worksheets(Worksheets.Count)) wsSummary.Name = "見出し" Else wsSummary.Cells.Clear ' 既存のデータをクリア End If On Error GoTo 0 ' 見出しの設定 wsSummary.Cells(1, 1).Resize(1, 8).Value = Array("品種", "工程", "最小値", "最大値", "平均値", "N数", "分散", "標準偏差") SummaryRow = 2 ' 品種＆工程ごとに統計を計算 Set ProcessCategory_List = CreateObject("Scripting.Dictionary") For i = 2 To LAST_R ProcessCategory = wsData.Cells(i, 2).Value & "＆" & wsData.Cells(i, 3).Value ' 品種＆工程（B列＆C列） If Not ProcessCategory_List.exists(ProcessCategory) Then ProcessCategory_List.Add ProcessCategory, Nothing End If Next i For Each Category In ProcessCategory_List.Keys Set Results = New Collection ' 対象データの収集 For i = 1 To UBound(Data_C, 1) ProcessCategory = Data_C(i, 1) & "＆" & Data_C(i, 2) ' 品種＆工程 If ProcessCategory = Category Then Results.Add Data_C(i, LAST_C - 1) ' データ列の数値を収集 End If Next i ' 統計計算の実行 If Results.Count > 0 Then ReDim Values(1 To Results.Count) For j = 1 To Results.Count Values(j) = Results(j) Next j ' 品種と工程を分離 CategorySplit = Split(Category, "＆") ' 統計値の計算と出力 wsSummary.Cells(SummaryRow, 1).Value = CategorySplit(0) ' 品種 wsSummary.Cells(SummaryRow, 2).Value = CategorySplit(1) ' 工程 wsSummary.Cells(SummaryRow, 3).Value = WorksheetFunction.Min(Values) wsSummary.Cells(SummaryRow, 4).Value = WorksheetFunction.Max(Values) wsSummary.Cells(SummaryRow, 5).Value = WorksheetFunction.Average(Values) wsSummary.Cells(SummaryRow, 6).Value = Results.Count wsSummary.Cells(SummaryRow, 7).Value = WorksheetFunction.Var(Values) wsSummary.Cells(SummaryRow, 8).Value = WorksheetFunction.StDev(Values) SummaryRow = SummaryRow + 1 End If Next Category End Sub |
コードの解説
このVBAコードは、大きく分けて３つの機能で構成されています。
- Sample10：以前に紹介した「大量のデータを品種別にワークシートに自動分類」を実行します。
- Sample08：以前に紹介した「開始終了データから各工程の所要時間を自動計算」を実行します。
- 基本統計量計算：今回新たに作成した、計算した所要時間を用いて基本統計量を「見出し」シートに算出します。
Sample10の変更箇所
- １２行目：所要時間列が空の為、１行目のヘッダー行参照に変更
LAST_C = wsData.Cells(1, Columns.Count).End(xlToLeft).Column」 - １６行目：所要時間計算ロジック（Sample08）の呼び出しを追加
Call Sample08(LAST_R) - ３８行目：基本統計量計算ロジックの呼び出しを追加
Call CreateSummarySheet(wsData, LAST_C, LAST_R, Data_C, Category_List)
コードを表示するには三角マークをクリックしてください。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 |
Sub Sample10() ' グレード名、グレード、データの配列を定義 Dim Category_Name As Variant, Category As Variant, Data_C As Variant Dim Category_List As Object ' グレード名を保持する辞書 Dim wsData As Worksheet, wsCategory As Worksheet ' データシートとグレードシートの参照 Dim LAST_R As Long, LAST_C As Long ' データ範囲の最終行と最終列 ' データシートの参照を設定 Set wsData = Worksheets("データシート") ' データシートの最終列行を取得 LAST_C = wsData.Cells(1, Columns.Count).End(xlToLeft).Column LAST_R = wsData.Cells(Rows.Count, 2).End(xlUp).Row '所要時間計算 Call Sample08(LAST_R) ' グレードリストを取得 Call GetCategory(Category, Category_List, wsData, LAST_R) ' グレード名称を配列に変換 Category_Name = Category_List.Keys ' データを配列に読み込む（2行目以降のデータ範囲） Data_C = wsData.Range(wsData.Cells(2, 2), wsData.Cells(LAST_R, LAST_C)).Value ' 各グレードごとに処理 For Each Category In Category_Name Set wsCategory = Nothing ' ワークシート参照のリセット ' グレード用のワークシートを作成または取得 Call MakeWorkSheet(Category, wsCategory) ' データを各グレードのワークシートに貼り付け Call DataPaste(Category, wsCategory, LAST_C, Data_C) Next Category Call CreateSummarySheet(wsData, LAST_C, LAST_R, Data_C, Category_List) End Sub Sub GetCategory(ByRef Category As Variant, _ ByRef Category_List As Object, _ ByRef wsData As Worksheet, _ ByVal LAST_R As Long) ' グレード名称リストの作成（重複を排除） Dim i As Long ' グレード名を保持する辞書を作成 Set Category_List = CreateObject("Scripting.Dictionary") ' 各行のグレードを辞書に追加（重複を防ぐ） For i = 2 To LAST_R Category = wsData.Cells(i, 2).Value If Not Category_List.exists(Category) Then Category_List.Add Category, Nothing End If Next i End Sub Sub MakeWorkSheet(ByVal Category As Variant, _ ByRef wsCategory As Worksheet) ' グレード用のワークシートの存在確認と新規作成 On Error Resume Next ' エラーを無視して既存のワークシートを探す Set wsCategory = Worksheets(Category) On Error GoTo 0 ' エラー処理をリセット ' ワークシートが存在しない場合は新規作成 If wsCategory Is Nothing Then Set wsCategory = Worksheets.Add(After:=Worksheets(Worksheets.Count)) wsCategory.Name = Category ' ワークシート名をグレード名に設定 Else ' 既存のワークシートの場合、必要に応じて内容をクリアなどの処理を追加 End If ' ワークシートのフォーマットを設定 Call FormatChange(wsCategory) End Sub Sub DataPaste(ByVal Category As Variant, _ ByVal wsCategory As Worksheet, _ ByVal LAST_C As Long, _ ByVal Data_C As Variant) ' グレードに対応する行をフィルタリングして貼り付け Dim RowCounter As Long ' 貼り付け行のカウンタ Dim i As Long ' 初期貼り付け行位置 RowCounter = 0 ' 配列から該当するグレードの行をフィルタしてワークシートに貼り付け For i = 1 To UBound(Data_C, 1) If Data_C(i, 1) = Category Then wsCategory.Cells(RowCounter + 2, 2).Resize(1, LAST_C - 1).Value = _ Application.Index(Data_C, i, 0) ' 該当行を貼り付け RowCounter = RowCounter + 1 ' 次の行に移動 End If Next i End Sub Sub FormatChange(ByVal PasteDestination As Worksheet) Dim wsSorce As Worksheet Dim rngTable As Range ' データシートの参照を取得 Set wsSorce = Worksheets("データシート") ' データシートのA列をコピーして、各グレードシートのA列に貼り付け wsSorce.Columns("A:A").Copy Destination:=PasteDestination.Columns("A:A") ' データシートの1行目をコピーして、各グレードシートの1行目に貼り付け wsSorce.Rows("1:1").Copy Destination:=PasteDestination.Rows("1:1") ' シートのA1を起点として表全体の範囲を動的に取得 Set rngTable = PasteDestination.Range("A1").CurrentRegion ' 表全体に枠線を設定 With rngTable.Borders .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With End Sub |
Sample08の変更箇所
- １行目：LastRowの変数をSample10からの引数に変更
Sub Sample08(ByVal LastRow As Long) - ３～８行目：それぞれのセルを変更
Dim StartHourCell As Range: Set StartHourCell = Range(“D2“) ‘ 開始時のセル
Dim StartMinuteCell As Range: Set StartMinuteCell = Range(“E2“) ‘ 開始分のセル
Dim EndHourCell As Range: Set EndHourCell = Range(“F2“) ‘ 終了時のセル
Dim EndMinuteCell As Range: Set EndMinuteCell = Range(“G2“) ‘ 終了分のセル
Dim ResultCell As Range: Set ResultCell = Range(“H2“) ‘ 結果の出力セル - １１、１６行目：引数に変更によるコメントアウト
Dim NN As Long ‘, LastRow As Long
‘LastRow = StartMinuteCell.End(xlDown).Row
コードを表示するには三角マークをクリックしてください。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 |
Sub Sample08(ByVal LastRow As Long) ' 設定セクション（セル参照で設定） Dim DataStartCell As Range: Set DataStartCell = Range("B2") ' データの開始セル Dim StartHourCell As Range: Set StartHourCell = Range("D2") ' 開始時のセル Dim StartMinuteCell As Range: Set StartMinuteCell = Range("E2") ' 開始分のセル Dim EndHourCell As Range: Set EndHourCell = Range("F2") ' 終了時のセル Dim EndMinuteCell As Range: Set EndMinuteCell = Range("G2") ' 終了分のセル Dim ResultCell As Range: Set ResultCell = Range("H2") ' 結果の出力セル ' 変数の宣言 Dim NN As Long ', LastRow As Long Dim HourDiff As Double, MinuteDiff As Double Dim Results() As Variant ' データの最終行を取得 'LastRow = StartMinuteCell.End(xlDown).Row ' 結果を格納する配列を初期化 ReDim Results(DataStartCell.Row To LastRow) For NN = DataStartCell.Row To LastRow ' 時間差の計算（終了時 - 開始時） HourDiff = Cells(NN, EndHourCell.Column).Value - Cells(NN, StartHourCell.Column).Value MinuteDiff = Cells(NN, EndMinuteCell.Column).Value - Cells(NN, StartMinuteCell.Column).Value ' 時間差が負の場合は24時間を加算 If HourDiff < 0 Or (HourDiff = 0 And MinuteDiff < 0) Then HourDiff = HourDiff + 24 ' 配列に合計時間を格納 Results(NN) = TimeSerial(HourDiff, MinuteDiff, 0) Next NN ' 一括でセルに書き込む ResultCell.Resize(LastRow - DataStartCell.Row + 1).Value = Application.Transpose(Results) End Sub |
基本統計量計算の特徴
データを格納する際に「Scripting.Dictionary」を使用しているが、今回は「品種」と「工程」の２つを見て統計量の計算をする必要があります。そこで、データ収集の際には「品種＆工程」という形でマージしてデータを取得し、出力する際に「Split」を使用して分離という作業を行っています。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 |
Sub CreateSummarySheet(ByVal wsData As Worksheet, _ ByVal LAST_C As Long, _ ByVal LAST_R As Long, _ ByVal Data_C As Variant, _ ByVal Category_List As Object) Dim wsSummary As Worksheet Dim Category As Variant, Process As Variant Dim i As Long, j As Long, SummaryRow As Long Dim Values() As Double Dim Results As Collection Dim ProcessCategory As String Dim ProcessCategory_List As Object Dim CategorySplit As Variant ' 見出しシートの作成または取得 On Error Resume Next Set wsSummary = Worksheets("見出し") If wsSummary Is Nothing Then Set wsSummary = Worksheets.Add(After:=Worksheets(Worksheets.Count)) wsSummary.Name = "見出し" Else wsSummary.Cells.Clear ' 既存のデータをクリア End If On Error GoTo 0 ' 見出しの設定 wsSummary.Cells(1, 1).Resize(1, 8).Value = Array("品種", "工程", "最小値", "最大値", "平均値", "N数", "分散", "標準偏差") SummaryRow = 2 ' 品種＆工程ごとに統計を計算 Set ProcessCategory_List = CreateObject("Scripting.Dictionary") For i = 2 To LAST_R ProcessCategory = wsData.Cells(i, 2).Value & "＆" & wsData.Cells(i, 3).Value ' 品種＆工程（B列＆C列） If Not ProcessCategory_List.exists(ProcessCategory) Then ProcessCategory_List.Add ProcessCategory, Nothing End If Next i For Each Category In ProcessCategory_List.Keys Set Results = New Collection ' 対象データの収集 For i = 1 To UBound(Data_C, 1) ProcessCategory = Data_C(i, 1) & "＆" & Data_C(i, 2) ' 品種＆工程 If ProcessCategory = Category Then Results.Add Data_C(i, LAST_C - 1) ' データ列の数値を収集 End If Next i ' 統計計算の実行 If Results.Count > 0 Then ReDim Values(1 To Results.Count) For j = 1 To Results.Count Values(j) = Results(j) Next j ' 品種と工程を分離 CategorySplit = Split(Category, "＆") ' 統計値の計算と出力 wsSummary.Cells(SummaryRow, 1).Value = CategorySplit(0) ' 品種 wsSummary.Cells(SummaryRow, 2).Value = CategorySplit(1) ' 工程 wsSummary.Cells(SummaryRow, 3).Value = WorksheetFunction.Min(Values) wsSummary.Cells(SummaryRow, 4).Value = WorksheetFunction.Max(Values) wsSummary.Cells(SummaryRow, 5).Value = WorksheetFunction.Average(Values) wsSummary.Cells(SummaryRow, 6).Value = Results.Count wsSummary.Cells(SummaryRow, 7).Value = WorksheetFunction.Var(Values) wsSummary.Cells(SummaryRow, 8).Value = WorksheetFunction.StDev(Values) SummaryRow = SummaryRow + 1 End If Next Category End Sub |
使用技術
基本：Split、WorksheetFunction、
参照：開始終了データから各工程の所要時間を自動計算 【過去紹介記事へ】
大量のデータを品種別にワークシートに自動分類 【過去紹介記事へ】
まとめ
本記事では、Excel VBAを使用してデータ整理の自動化を行う方法を紹介しました。シート分類、所要時間の計算、基本統計量の算出を自動化することで、手作業の負担を軽減し、データ処理の精度と効率を大幅に向上させることができます。これにより、日々の業務でのExcel操作がさらにスムーズになり、時間の節約にもつながります。
VBAのコードは直接コピーして使用することもでき、VBAの基本を理解している方にとってはカスタマイズの参考にもなります。この記事をきっかけに、Excelでのデータ処理を自動化し、業務効率化を目指してみてください。
コメント