Excel VBA 逆引き集 | 複数列の合計

Excel VBA
スポンサーリンク

複数列の合計

「横方向に複数列を足す」「縦方向に列合計を出す」「非連続列だけ選んで合計」「見出し名で列を探して合計」まで、初心者でも安全に使えるテンプレをまとめました。行単位・列単位・見え方(可視セル)・大量データの高速化も網羅します。


よく使う最短テンプレ

  • 横合計(1行の複数列を合算)
Sub SumRow_Horizontal()
    Dim r As Long: r = 2 '例:2行目
    Cells(r, "H").Value = WorksheetFunction.Sum(Range(Cells(r, "C"), Cells(r, "F"))) 'C~F列の横合計をH列へ
End Sub
VB
  • 縦合計(列の合計を取得)
Sub SumColumn_Vertical()
    Dim total As Double
    total = WorksheetFunction.Sum(Range("D2:D10000")) 'D列の縦合計
    Range("H2").Value = total
End Sub
VB
  • 非連続列の合計(同一行でC,E,G列だけ)
Sub SumRow_NonContiguous()
    Dim r As Long: r = 2
    Cells(r, "H").Value = WorksheetFunction.Sum(Union(Cells(r, "C"), Cells(r, "E"), Cells(r, "G")))
End Sub
VB
  • 非連続列を縦方向で合計(列C+E+Gの総和)
Sub SumColumns_NonContiguous_Vertical()
    Dim total As Double
    total = WorksheetFunction.Sum(Range("C2:C10000")) + _
            WorksheetFunction.Sum(Range("E2:E10000")) + _
            WorksheetFunction.Sum(Range("G2:G10000"))
    Range("H2").Value = total
End Sub
VB

行方向の一括合計(複数列→合計列へ一気に書く)

Sub SumRows_Block()
    Dim last As Long: last = Cells(Rows.Count, "A").End(xlUp).Row
    Dim r As Long
    For r = 2 To last
        Cells(r, "H").Value = WorksheetFunction.Sum(Range(Cells(r, "C"), Cells(r, "F"))) 'C~F列を合計
    Next
End Sub
VB
  • ポイント:
    • 合計列を固定: H列に結果を書き込む前提。必要に応じて列文字を変更。
    • ヘッダー除外: 2行目から処理。

可視セルだけ合計(フィルタ後に見えている値のみ)

Sub Sum_VisibleOnly()
    With Range("A1").CurrentRegion
        .AutoFilter Field:=1, Criteria1:="営業" '例の絞り込み
        Dim vis As Range
        On Error Resume Next
        Set vis = .Columns(4).SpecialCells(xlCellTypeVisible) 'D列の可視セル
        On Error GoTo 0
        If Not vis Is Nothing Then Range("H2").Value = WorksheetFunction.Sum(vis)
        .AutoFilter '解除
    End With
End Sub
VB
  • ポイント:
    • フィルタ後の見た目に合わせた合計がほしいときに便利。
    • 解除忘れ防止: 最後に .AutoFilter で元に戻す。

見出し名で列を探して合計(列順が変わっても壊れない)

Function GetColumnByHeader(ByVal headerName As String, ByVal headerRow As Range) As Long
    Dim hit As Range
    Set hit = headerRow.Find(What:=headerName, LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
    GetColumnByHeader = IIf(hit Is Nothing, 0, hit.Column)
End Function

Sub Sum_ByHeaderNames()
    Dim head As Range: Set head = Range("A1").CurrentRegion.Rows(1)
    Dim cQty As Long:  cQty = GetColumnByHeader("数量", head)
    Dim cPrice As Long: cPrice = GetColumnByHeader("単価", head)
    Dim cDisc As Long: cDisc = GetColumnByHeader("値引", head)

    If cQty * cPrice = 0 Then
        MsgBox "必要な見出しが見つかりません": Exit Sub
    End If

    Dim last As Long: last = Cells(Rows.Count, cQty).End(xlUp).Row
    Dim r As Long
    For r = 2 To last
        '数量×単価−値引の計算をH列へ
        Cells(r, "H").Value = Val(Cells(r, cQty).Value) * Val(Cells(r, cPrice).Value) - Val(Cells(r, cDisc).Value)
    Next
End Sub
VB
  • ポイント:
    • 列名で参照: 列順変更に耐える。
    • 値の正規化: Val で安全な数値化。

大量データ高速版:配列でまとめて合計→一括書き戻し

Sub SumRows_ArrayFast()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim rg As Range: Set rg = Range("A1").CurrentRegion
    Dim v As Variant: v = rg.Value '表全体を配列へ

    Dim i As Long
    ReDim out(1 To UBound(v, 1) - 1, 1 To 1) As Double '出力配列(行数-1, 1列)
    For i = 2 To UBound(v, 1)
        '例:C~F列の横合計
        out(i - 1, 1) = Val(v(i, 3)) + Val(v(i, 4)) + Val(v(i, 5)) + Val(v(i, 6))
    Next

    'H列に一括書き戻し(ヘッダー行を除いて貼る)
    Range("H2").Resize(UBound(out, 1), 1).Value = out

Cleanup:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
VB
  • ポイント:
    • セル往復を避ける: 範囲→配列で計算→一括貼り付けが最速。
    • 列参照は配列の列番号で: 3=列C、4=列D…のように対応。

Evaluateで行の横合計を一括(式を使って高速)

Sub SumRows_Evaluate()
    Dim last As Long: last = Cells(Rows.Count, "A").End(xlUp).Row
    'H2:Hlast に =SUM(C2:F2) の式を一括投入→値化
    With Range("H2:H" & last)
        .FormulaR1C1 = "=SUM(RC3:RC6)" 'C~F列
        .Value = .Value                 '値に変換(再計算負荷を除去)
    End With
End Sub
VB
  • ポイント:
    • 式で一括計算→値化は簡単で速い。R1C1記法が行単位の式展開に便利。

非連続列の和を式で一括(SUMの複数範囲)

Sub SumRows_NonContig_Evaluate()
    Dim last As Long: last = Cells(Rows.Count, "A").End(xlUp).Row
    With Range("H2:H" & last)
        .FormulaR1C1 = "=SUM(RC3,RC5,RC7)" 'C,E,G列の横合計
        .Value = .Value
    End With
End Sub
VB
  • ポイント:
    • 複数セルを列挙して合計できる(非連続列に向く)。

合計値の見える化(条件付き書式補助)

Sub Highlight_BigTotals()
    With Range("H2:H" & Cells(Rows.Count, "H").End(xlUp).Row)
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=100000"
        .FormatConditions(1).Interior.Color = RGB(255, 200, 200) '10万超を赤
    End With
End Sub
VB
  • ポイント:
    • 閾値で色付けすると集計結果の異常が目視で分かる。

よくある落とし穴と対策

  • 数字が文字列で合計されない
    • 対策: Val で数値化、または値化(.Value = .Value)。入力データ整備が最優先。
  • フィルタで非表示行も合計してしまう
    • 対策: 可視セルだけ合計するテンプレ(SpecialCells)を使う。
  • 列順が変わって壊れる
    • 対策: 見出し→列番号の取得関数(Find)で動的に参照。
  • セル往復が遅い
    • 対策: 配列で読み込み→まとめて計算→一括書き戻し。
  • 非連続列の範囲指定ミス
    • 対策: Unionか式で列挙(Evaluate の SUM(RC3,RC5,…))にする。

例題で練習

'例1:C~F列の横合計をH列へ一括(Evaluate)
Sub Example_HorizontalSum()
    Call SumRows_Evaluate
End Sub

'例2:フィルタ後の可視セルだけD列合計をH2へ
Sub Example_VisibleSum()
    Call Sum_VisibleOnly
End Sub

'例3:見出し「数量」「単価」「値引」を使って合計・計算
Sub Example_ByHeader()
    Call Sum_ByHeaderNames
End Sub

'例4:C,E,G列の横合計(非連続)をH列へ
Sub Example_NonContigRowSum()
    Call SumRows_NonContig_Evaluate
End Sub
VB
タイトルとURLをコピーしました