Excel VBA | Subプロシージャ（マクロ）の考え方

VBA
2010.06.17
スポンサーリンク
  1. 上級VBA演習 20問 — 模範解答コード & 詳細解説（図解付き）
  2. 問題1：複数ブックの一括集計（安全設計）
    1. 仕様の要約
    2. 模範解答（コード）
    3. 解説
  3. 問題2：マスタ検証（Dictionary × ネスト構造）
    1. 要約
    2. 模範解答
    3. 解説
  4. 問題3：動的配列への 2段階フィルタ
    1. 要約
    2. 模範解答
    3. 解説
  5. 問題4：SQL 的グループ集計（手書き集計）
    1. 要約
    2. 模範解答
    3. 解説
  6. 問題5：Range を再帰的に走査
    1. 要約
    2. 模範解答
    3. 解説
  7. 問題6：ユーザーフォームを使ったフィルタ UI
    1. 要約
    2. 実装ポイント（コード抜粋）
    3. 解説
  8. 問題7：イベントログの自動書き出し（Workbook モジュール）
    1. 要約
    2. 模範解答（ThisWorkbook）
    3. 解説
  9. 問題8：高速一括置換（正規化処理）
    1. 要約
    2. 模範解答（簡易版）
    3. 解説
  10. 問題9：構造化された行データをクラス化
    1. 要約
    2. Class Module（ClsProduct）
    3. 集計を行う Sub
    4. 解説
  11. 問題10：ファイル監視ツール
    1. 要約
    2. 模範解答（簡易）
    3. 解説
  12. 問題11：図形オブジェクトの一括処理
    1. 模範解答
    2. 解説
  13. 問題12：シート比較ツール（差分チェック）
    1. 模範解答
    2. 解説
  14. 問題13：ログローテーション（古いログの自動削除）
    1. 模範解答
    2. 解説
  15. 問題14：メール一括送信（Outlook 連携）
    1. 模範解答（簡易）
    2. 解説
  16. 問題15：DB 接続（ADO）でのデータ抽出
    1. 模範解答（Access 例）
    2. 解説
  17. 問題16：名前付き範囲を自動作成
    1. 模範解答
    2. 解説
  18. 問題17：カスタム並べ替え（独自順位テーブル）
    1. 模範解答
    2. 解説
  19. 問題18：階層構造データの展開（ツリー形式）
    1. 模範解答（再帰関数を使用）
    2. 解説
  20. 問題19：VBE モジュール自動生成ツール
    1. 模範解答
    2. 解説
  21. 問題20：データの不整合検出（縦横一致チェック）
    1. 模範解答
    2. 解説
  22. 最後に — 推奨改善ポイント

上級VBA演習 20問 — 模範解答コード & 詳細解説（図解付き）

このドキュメントは、先に提示した 追加の上級問題（20問） に対する 模範解答コード と 詳しい解説（図解） をまとめたものです。

注意：コードは実務向けを想定し、エラー処理やリソース解放（ファイル/ブックのクローズ等）を含めています。必要に応じて参照設定（例：Microsoft Scripting Runtime や Microsoft ActiveX Data Objects）を行ってください。

問題1：複数ブックの一括集計（安全設計）

仕様の要約

  • 指定フォルダ内の全ブックを順に開き、シート名="売上" の B2 を合算する。
  • エラーがあっても必ずブックを閉じる（Finally 相当の処理）

模範解答（コード）

Sub SumB2InFolder()
    Dim fso As Object
    Dim folderPath As String
    Dim f As Object, wb As Workbook
    Dim total As Double
    Dim fileName As String

    folderPath = InputBox("フォルダのフルパスを入力してください")
    If folderPath = "" Then Exit Sub

    If Right(folderPath, 1) <> "\"" Then folderPath = folderPath & "\"

    fileName = Dir(folderPath & "*.xls*")

    Application.ScreenUpdating = False
    Do While fileName <> ""
        On Error GoTo ErrHandler
        Set wb = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
        On Error GoTo 0

        If SheetExists(wb, "売上") Then
            total = total + NzVal(wb.Worksheets("売上").Range("B2").Value)
        End If

        wb.Close SaveChanges:=False
        Set wb = Nothing

        fileName = Dir()
    Loop

    Application.ScreenUpdating = True
    MsgBox "合計: " & total
    Exit Sub

ErrHandler:
    ' エラーでもブックを閉じて続行
    If Not wb Is Nothing Then
        On Error Resume Next
        wb.Close SaveChanges:=False
        Set wb = Nothing
        On Error GoTo 0
    End If
    fileName = Dir()
    Resume Next
End Sub

Function SheetExists(wb As Workbook, sName As String) As Boolean
    Dim sh As Worksheet
    On Error Resume Next
    Set sh = wb.Worksheets(sName)
    SheetExists = Not sh Is Nothing
    Set sh = Nothing
    On Error GoTo 0
End Function

Function NzVal(v As Variant) As Double
    If IsNumeric(v) Then NzVal = CDbl(v) Else NzVal = 0
End Function
VB

解説

  • Dir でフォルダ内のファイルを順に取得。
  • Workbooks.Open を使って読み取り専用で開く。もし 売上 シートが無ければスキップ。
  • 途中でエラーが発生しても ErrHandler で開いたブックを閉じ、Resume Next で次ファイルへ進める設計。

図（処理フロー）

Start -> Dir取得ループ -> Open workbook -> If sheet exists then add B2 -> Close workbook -> next file -> End

問題2：マスタ検証（Dictionary × ネスト構造）

要約

  • A列コード・B列商品名・C列カテゴリから、カテゴリ別の商品の一覧を Dictionary（カテゴリキー→配列）で作る。

模範解答

Sub BuildCategoryDict()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")

    Dim lastRow As Long, i As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row

    Dim cat As String, prod As String
    For i = 2 To lastRow
        prod = Trim(Cells(i, 2).Value)
        cat = Trim(Cells(i, 3).Value)
        If prod = "" Or cat = "" Then GoTo NextRow

        If Not dic.Exists(cat) Then
            dic.Add cat, Array(prod)
        Else
            dic(cat) = AppendToArray(dic(cat), prod)
        End If
NextRow:
    Next i

    ' 結果表示
    Dim k As Variant, msg As String
    For Each k In dic.Keys
        msg = msg & k & ": " & Join(dic(k), ", ") & vbCrLf
    Next
    MsgBox msg
End Sub

Function AppendToArray(arr As Variant, v As Variant) As Variant
    Dim i As Long
    Dim res() As Variant
    Dim n As Long
    n = UBound(arr) - LBound(arr) + 1
    ReDim res(0 To n)
    For i = 0 To UBound(arr)
        res(i) = arr(i)
    Next i
    res(n) = v
    AppendToArray = res
End Function
VB

解説

  • Scripting.Dictionary を使い、カテゴリ をキー、商品リスト を値とする。値は配列で保持。
  • 配列へ追加するユーティリティ AppendToArray を用意。

図（データ→辞書）

(A,B,C) rows -> for each row: dic[category].append(product)

問題3：動的配列への 2段階フィルタ

要約

  • 10,000行のデータから「数値>=100」かつ「文字列が ‘A’ で始まる」行だけを抽出して配列に格納。

模範解答

Sub TwoStepFilter()
    Dim data As Variant
    Dim out() As Variant
    Dim i As Long, cnt As Long

    data = Range("A1:C10000").Value ' 例：列A~C が対象
    ReDim out(1 To UBound(data, 1), 1 To UBound(data, 2))

    For i = 1 To UBound(data, 1)
        If IsNumeric(data(i, 2)) And data(i, 2) >= 100 Then
            If Left(CStr(data(i, 1)), 1) = "A" Then
                cnt = cnt + 1
                Dim j As Long
                For j = 1 To UBound(data, 2)
                    out(cnt, j) = data(i, j)
                Next j
            End If
        End If
    Next i

    If cnt = 0 Then
        MsgBox "該当行なし"
        Exit Sub
    End If

    ' 結果を新シートに書き出す
    Dim sh As Worksheet
    Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
    sh.Range("A1").Resize(cnt, UBound(data, 2)).Value = _
        Application.Index(out, Evaluate("ROW(1:" & cnt & ")"), 0)
End Sub
VB

解説

  • 一度に配列へ読み込み（高速化）、条件判定して出力配列へ詰める。
  • 最後に Resize で書き戻す。

問題4：SQL 的グループ集計（手書き集計）

要約

  • 2次元配列を読み、カテゴリごとの売上合計を計算し別シートに出力する。

模範解答

Sub GroupSumByCategory()
    Dim data As Variant
    data = Range("A2:C1001").Value  ' A:カテゴリ, B:商品, C:売上

    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")

    Dim i As Long
    For i = 1 To UBound(data, 1)
        Dim cat As String: cat = CStr(data(i, 1))
        Dim val As Double: val = NzVal(data(i, 3))
        If dic.Exists(cat) Then
            dic(cat) = dic(cat) + val
        Else
            dic.Add cat, val
        End If
    Next i

    ' 出力
    Dim outSh As Worksheet
    Set outSh = Sheets.Add(After:=Sheets(Sheets.Count))
    outSh.Range("A1").Value = "カテゴリ"
    outSh.Range("B1").Value = "合計"
    Dim r As Long: r = 2
    Dim k As Variant
    For Each k In dic.Keys
        outSh.Cells(r, 1).Value = k
        outSh.Cells(r, 2).Value = dic(k)
        r = r + 1
    Next k
End Sub
VB

解説

  • 配列走査＋Dictionary 集計は SQL の GROUP BY に相当。
  • メモリ内処理のため速度が速い（大データに有利）。

問題5：Range を再帰的に走査

要約

  • シート内のセルを効率良く走査し、赤色セルをリスト化する。

模範解答

Sub FindRedCells()
    Dim sh As Worksheet: Set sh = ActiveSheet
    Dim used As Range: Set used = sh.UsedRange
    Dim c As Range
    Dim results As Collection: Set results = New Collection

    For Each c In used.Cells
        If c.Interior.Color = vbRed Then
            results.Add c.Address
        End If
    Next c

    Dim msg As String, i As Long
    For i = 1 To results.Count
        msg = msg & results(i) & vbCrLf
    Next i

    MsgBox msg
End Sub
VB

解説

  • UsedRange を使えばシート全体を走査するより効率的。
  • 再帰はここでは不要（セル単位の列挙で十分）。

問題6：ユーザーフォームを使ったフィルタ UI

要約

  • テキストボックスでキーワードを受け取り、ListBox に検索結果を表示するフォームを作る。

実装ポイント（コード抜粋）

' ユーザーフォーム UserForm1 のコード例
Private Sub btnSearch_Click()
    Dim kw As String
    kw = Me.txtKeyword.Value
    Me.lstResults.Clear

    Dim data As Variant
    data = ThisWorkbook.Sheets("データ").Range("A2:A1000").Value

    Dim i As Long
    For i = 1 To UBound(data, 1)
        If InStr(1, data(i, 1), kw, vbTextCompare) > 0 Then
            Me.lstResults.AddItem data(i, 1)
        End If
    Next i
End Sub
VB

解説

  • ユーザーフォーム内で Sub を分割しておくとテストしやすい（例：検索ロジックはモジュール化して呼び出す）。
  • ListBox は .AddItem で追加。

問題7：イベントログの自動書き出し（Workbook モジュール）

要約

  • Workbook のイベント（Open, BeforeClose, AfterSave など）を検知してログに記録する。

模範解答（ThisWorkbook）

Private Sub Workbook_Open()
    LogWrite "Workbook opened"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    LogWrite "Workbook closing"
End Sub

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    If Success Then LogWrite "Workbook saved"
End Sub
VB

LogWrite は前述の汎用ログ関数を使用。

解説

  • Workbook イベントは ThisWorkbook モジュールに置く。
  • ログは共有関数 LogWrite に委譲すると保守しやすい。

問題8：高速一括置換（正規化処理）

要約

  • 大量データに対して全角→半角、trim、特定記号除去などを高速に行う。

模範解答（簡易版）

Sub NormalizeData()
    Dim data As Variant
    data = Range("A1:A10000").Value

    Dim i As Long
    For i = 1 To UBound(data, 1)
        Dim s As String
        s = CStr(data(i, 1))
        s = Trim(s)
        s = Replace(s, "★", "")
        s = StrConv(s, vbNarrow) ' 全角→半角
        data(i, 1) = s
    Next i

    Range("A1:A10000").Value = data
End Sub
VB

解説

  • セル単位で毎回読み書きするより、一度配列に読み込んで処理後に一括書き戻す方が高速。
  • StrConv(..., vbNarrow) で全角→半角。

問題9：構造化された行データをクラス化

要約

  • Class Module（例：ClsProduct）を作り、商品情報をプロパティとして管理する。

Class Module（ClsProduct）

' ClsProduct
Public Name As String
Public Quantity As Long
Public Price As Double

Public Function Total() As Double
    Total = Quantity * Price
End Function
VB

集計を行う Sub

Sub UseProductClass()
    Dim list As Collection: Set list = New Collection
    Dim i As Long, last As Long
    last = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To last
        Dim p As New ClsProduct
        p.Name = Cells(i, 1).Value
        p.Quantity = Cells(i, 2).Value
        p.Price = Cells(i, 3).Value
        list.Add p
    Next i

    Dim total As Double
    Dim it As Variant
    For Each it In list
        total = total + it.Total
    Next
    MsgBox "合計金額: " & total
End Sub
VB

解説

  • クラスを使うと1行分のデータにメソッドを持たせられ、ビジネスロジックをオブジェクトにまとめられる。

問題10：ファイル監視ツール

要約

  • 指定フォルダを定期チェックして新規ファイルを検出、ログに記録する。Application.OnTime を使用。

模範解答（簡易）

Public nextRunTime As Date
Public watchFolder As String
Public knownFiles As Object

Sub StartWatcher()
    watchFolder = InputBox("監視フォルダを入力")
    If watchFolder = "" Then Exit Sub
    If Right(watchFolder, 1) <> "\"" Then watchFolder = watchFolder & "\"

    Set knownFiles = CreateObject("Scripting.Dictionary")
    Dim f As String
    f = Dir(watchFolder & "*.*")
    Do While f <> ""
        knownFiles.Add f, 1
        f = Dir()
    Loop

    nextRunTime = Now + TimeValue("00:00:30")
    Application.OnTime earliesttime:=nextRunTime, procedure:="WatcherTick", schedule:=True
End Sub

Sub WatcherTick()
    Dim f As String
    f = Dir(watchFolder & "*.*")
    Do While f <> ""
        If Not knownFiles.Exists(f) Then
            knownFiles.Add f, 1
            LogWrite "New file: " & f
        End If
        f = Dir()
    Loop
    nextRunTime = Now + TimeValue("00:00:30")
    Application.OnTime earliesttime:=nextRunTime, procedure:="WatcherTick", schedule:=True
End Sub

Sub StopWatcher()
    On Error Resume Next
    Application.OnTime earliesttime:=nextRunTime, procedure:="WatcherTick", schedule:=False
    On Error GoTo 0
End Sub
VB

解説

  • 初回に既存ファイルを辞書に登録しておき、OnTime で定期実行するチェック処理を繰り返す。
  • 新規ファイル発見時に LogWrite を呼び出して記録する。

問題11：図形オブジェクトの一括処理

模範解答

Sub ColorBtnShapes()
    Dim sh As Worksheet: Set sh = ActiveSheet
    Dim shp As Shape
    For Each shp In sh.Shapes
        If Left(shp.Name, 4) = "btn_" Then
            On Error Resume Next
            shp.Fill.ForeColor.RGB = RGB(0, 112, 192) ' 青
            On Error GoTo 0
        End If
    Next shp
End Sub
VB

解説

  • Shapes コレクションをループし、名前でフィルタ。
  • 図形によって .Fill プロパティが無い場合があるので On Error で安全に回避。

問題12：シート比較ツール（差分チェック）

模範解答

Sub CompareSheets()
    Dim s1 As Worksheet, s2 As Worksheet, outSh As Worksheet
    Set s1 = Sheets("A")
    Set s2 = Sheets("B")
    Set outSh = Sheets.Add(After:=Sheets(Sheets.Count))
    outSh.Range("A1:C1").Value = Array("Address", "A", "B")

    Dim r As Long, c As Long, outR As Long: outR = 2
    Dim maxR As Long, maxC As Long
    maxR = Application.Max(s1.Cells(Rows.Count, 1).End(xlUp).Row, s2.Cells(Rows.Count, 1).End(xlUp).Row)
    maxC = Application.Max(s1.UsedRange.Columns.Count, s2.UsedRange.Columns.Count)

    For r = 1 To maxR
        For c = 1 To maxC
            Dim v1 As Variant, v2 As Variant
            v1 = s1.Cells(r, c).Value
            v2 = s2.Cells(r, c).Value
            If CStr(v1) <> CStr(v2) Then
                outSh.Cells(outR, 1).Value = Cells(r, c).Address(False, False)
                outSh.Cells(outR, 2).Value = v1
                outSh.Cells(outR, 3).Value = v2
                outR = outR + 1
            End If
        Next c
    Next r
End Sub
VB

解説

  • すべてのセルを比較するため maxR, maxC を算出。
  • 値を文字列化して比較すると Empty 等も扱いやすい。

問題13：ログローテーション（古いログの自動削除）

模範解答

Sub RotateLogs()
    Dim sh As Worksheet: Set sh = Sheets("ログ")
    Dim last As Long: last = sh.Cells(Rows.Count, 1).End(xlUp).Row
    Dim i As Long
    For i = last To 2 Step -1
        If IsDate(sh.Cells(i, 1).Value) Then
            If DateDiff("d", CDate(sh.Cells(i, 1).Value), Now) > 30 Then
                sh.Rows(i).Delete
            End If
        End If
    Next i
End Sub
VB

解説

  • 下から削除することで行番号のズレを防ぐ。

問題14：メール一括送信（Outlook 連携）

模範解答（簡易）

Sub BulkMail()
    Dim olApp As Object, olMail As Object
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
    On Error GoTo 0

    Dim last As Long, i As Long
    last = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To last
        Set olMail = olApp.CreateItem(0)
        With olMail
            .To = Cells(i, 1).Value
            .Subject = Cells(i, 2).Value
            .Body = Cells(i, 3).Value
            .Send
        End With
        Set olMail = Nothing
    Next i
End Sub
VB

解説

  • Outlook 連携は CreateObject("Outlook.Application") を使う。
  • 実行環境によりセキュリティプロンプトが出ることがあるので注意。

問題15：DB 接続（ADO）でのデータ抽出

模範解答（Access 例）

Sub QueryAccess()
    Dim cn As Object, rs As Object
    Dim dbPath As String, sql As String
    dbPath = InputBox("DBパスを入力")
    sql = "SELECT * FROM T_Sales WHERE SaleDate >= #2025-01-01#"

    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath

    Set rs = CreateObject("ADODB.Recordset")
    rs.Open sql, cn

    Sheets.Add(After:=Sheets(Sheets.Count)).Range("A1").CopyFromRecordset rs

    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
End Sub
VB

解説

  • ADO を使えば外部 DB のデータを直接シートへ取り込める。
  • Provider は環境に合わせて変更。

問題16：名前付き範囲を自動作成

模範解答

Sub CreateNamedRanges()
    Dim r As Long, c As Long
    Dim sht As Worksheet: Set sht = ActiveSheet
    Dim rng As Range

    Set rng = sht.Range("A1:D100")
    For r = 1 To rng.Rows.Count
        sht.Names.Add Name:="Row_" & r, RefersTo:=rng.Rows(r)
    Next r

    For c = 1 To rng.Columns.Count
        sht.Names.Add Name:="Col_" & Chr(64 + c), RefersTo:=rng.Columns(c)
    Next c
End Sub
VB

解説

  • Names.Add で名前付き範囲を作成する。
  • 多数作る場合は既存の名前チェックを入れると安全。

問題17：カスタム並べ替え（独自順位テーブル）

模範解答

Sub CustomSort()
    Dim orderSh As Worksheet: Set orderSh = Sheets("Order") ' A列に順位キー
    Dim keys As Variant
    keys = orderSh.Range("A1:A4").Value

    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim i As Long
    For i = 1 To UBound(keys, 1)
        dic(keys(i, 1)) = i
    Next i

    Dim dataSh As Worksheet: Set dataSh = Sheets("Data")
    Dim rng As Range: Set rng = dataSh.Range("A2:B100")
    Dim arr As Variant: arr = rng.Value

    ' ソート（バブルなどで簡易実装）
    Dim swapped As Boolean
    Dim j As Long
    Do
        swapped = False
        For j = 1 To UBound(arr, 1) - 1
            Dim k1 As Variant, k2 As Variant
            k1 = arr(j, 1): k2 = arr(j + 1, 1)
            If dic.Exists(k1) And dic.Exists(k2) Then
                If dic(k1) > dic(k2) Then
                    Dim tmp As Variant
                    tmp = arr(j, 1): arr(j, 1) = arr(j + 1, 1): arr(j + 1, 1) = tmp
                    swapped = True
                End If
            End If
        Next j
    Loop While swapped

    rng.Value = arr
End Sub
VB

解説

  • まず順位表を辞書化し、その優先順位に従って配列内で並べ替える。

問題18：階層構造データの展開（ツリー形式）

模範解答（再帰関数を使用）

Sub ExpandHierarchy()
    Dim data As Variant
    data = Range("A2:B100").Value ' A:ID, B:ParentID

    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim i As Long
    For i = 1 To UBound(data, 1)
        Dim id As String: id = CStr(data(i, 1))
        Dim pid As String: pid = CStr(data(i, 2))
        If Not dict.Exists(pid) Then dict.Add pid, New Collection
        dict(pid).Add id
    Next i

    Dim outSh As Worksheet: Set outSh = Sheets.Add
    Dim rowNo As Long: rowNo = 1
    Call PrintTree(dict, "", 0, outSh, rowNo)
End Sub

Sub PrintTree(dict As Object, parent As String, depth As Long, outSh As Worksheet, ByRef rowNo As Long)
    If Not dict.Exists(parent) Then Exit Sub
    Dim col As Collection: Set col = dict(parent)
    Dim i As Long
    For i = 1 To col.Count
        outSh.Cells(rowNo, 1).Value = String(depth * 2, " ") & col(i)
        rowNo = rowNo + 1
        Call PrintTree(dict, col(i), depth + 1, outSh, rowNo)
    Next i
End Sub
VB

解説

  • 親IDごとに子IDのコレクションを作成し、再帰で深さ優先に出力する。

問題19：VBE モジュール自動生成ツール

模範解答

Sub ImportBasFiles()
    Dim f As String, folderPath As String
    folderPath = InputBox(".basファイルがあるフォルダパス")
    If Right(folderPath, 1) <> "\"" Then folderPath = folderPath & "\"
    f = Dir(folderPath & "*.bas")
    Do While f <> ""
        ThisWorkbook.VBProject.VBComponents.Import folderPath & f
        f = Dir()
    Loop
End Sub
VB

注意：VBProject にアクセスするには「信頼できるアクセスのためのVBAプロジェクト オブジェクトモデル」にチェックが必要。

解説

  • 自動でモジュールを追加することができる。

問題20：データの不整合検出（縦横一致チェック）

模範解答

Sub CheckRowColTotals()
    Dim sh As Worksheet: Set sh = ActiveSheet
    Dim r As Long, c As Long
    Dim maxR As Long, maxC As Long
    maxR = sh.UsedRange.Rows.Count
    maxC = sh.UsedRange.Columns.Count

    Dim rowSum As Double, colSum As Double
    For r = 1 To maxR
        rowSum = Application.WorksheetFunction.Sum(sh.Rows(r))
        If rowSum <> sh.Cells(r, maxC + 1).Value Then
            sh.Rows(r).Interior.Color = vbRed
        End If
    Next r

    For c = 1 To maxC
        colSum = Application.WorksheetFunction.Sum(sh.Columns(c))
        If colSum <> sh.Cells(maxR + 1, c).Value Then
            sh.Columns(c).Interior.Color = vbRed
        End If
    Next c
End Sub
VB

解説

  • 事前に行合計・列合計を隣接セルに用意しておく想定。
  • 異なる行/列を赤色でハイライトする。

最後に — 推奨改善ポイント

  • 例外処理：業務で使うコードなら On Error ブロックを適切に入れてログに残しましょう。
  • パフォーマンス：大データ処理は Application.ScreenUpdating=False、Calculation=xlCalculationManual の併用を検討。
  • テスト：ユニットテスト的に小さなデータで挙動を確認してから本番データで実行。
前へ次へ
12345678910
VBA
スポンサーリンク
シェアする
@lifehackerをフォローする
スポンサーリンク
@lifehacker
スポンサーリンク
タイトルとURLをコピーしました