cr（カレントリージョン）で、列データの種類ごとに小計を取る。

cr（カレントリージョン）を条件分岐して取得する。

crは条件分岐して取得することができます。今回は、預金者区分１，２，３、の3種類のcrを作ってそれぞれの小計を出します。

目次
　 １　閲覧対象者
　 ２　得られる効果
　 ３　演習問題
　 ４　コードの解説　
　 ５　とある信用金庫さんへの悩みを解決する　
　 ６　感想

１　閲覧対象者

cr（カレントリージョン）を条件分岐で取得する方法を、マスターしたい人。

２　得られる効果

条件設定して得られたRangeを簡単に操作できます。

３　演習問題

以下のような表があります。

演習問題
・この表からA列の預金者区分１，２、３ごとに小計だしてください。

ポイントは、３つのRangeを宣言してそれぞれに範囲を取って合計を出すことです。
では、次の章の回答コードを見ていきましょう。

４　コードの解説

回答コード

Sub cr_Subtotal()

    Dim cr As Range: Set cr = Range("A1").CurrentRegion
    Dim i As Long
    Dim targetRange1 As Range, targetRange2 As Range, targetRange3 As Range
    Dim taget1_Subtotal, taget2_Subtotal, taget3_Subtotal
    
    For i = 2 To cr.Rows.Count
        '預金者区分１
        If cr.Cells(i, 1) = 1 Then
            If targetRange1 Is Nothing Then
                Set targetRange1 = cr.Rows(i)
            Else
                Set targetRange1 = Union(targetRange1, cr.Rows(i))
            End If
            
        '預金者区分２
        ElseIf cr.Cells(i, 1) = 2 Then
            If targetRange2 Is Nothing Then
                Set targetRange2 = cr.Rows(i)
            
            Else
                Set targetRange2 = Union(targetRange2, cr.Rows(i))
            End If
        
        '預金者区分３
        ElseIf cr.Cells(i, 1) = 3 Then
            If targetRange3 Is Nothing Then
                Set targetRange3 = cr.Rows(i)
            
            Else
                Set targetRange3 = Union(targetRange3, cr.Rows(i))
            End If
        End If
    Next
    
    '小計を取得する。
    If Not targetRange1 Is Nothing Then taget1_Subtotal = WorksheetFunction.Sum(targetRange1.Columns(3))
    If Not targetRange2 Is Nothing Then taget2_Subtotal = WorksheetFunction.Sum(targetRange2.Columns(3))
    If Not targetRange3 Is Nothing Then taget3_Subtotal = WorksheetFunction.Sum(targetRange3.Columns(3))
    
    Debug.Print taget1_Subtotal
    Debug.Print taget2_Subtotal
    Debug.Print taget3_Subtotal
        
End Sub

まず、区分が１、２、３と３つ存在するのでtargetRangeを３つ用意します（targetRange１～targetRange３）。
cr（カレントリージョン）のA列が１の場合は、targetRange１に範囲をSetします。
cr（カレントリージョン）のA列が２の場合は、targetRange２に範囲をSetします。
cr（カレントリージョン）のA列が３の場合は、targetRange３に範囲をSetします。
targetRange1 がNothingでない場合、targetRange１の預金額を合計します（Columns(3)が預金額欄です）。
targetRange２がNothingでない場合、targetRange２の預金額を合計します（Columns(3)が預金額欄です）。
targetRange２がNothingでない場合、targetRange３の預金額を合計します（Columns(3)が預金額欄です）。
Debug.Printでそれぞれ値を出します。

Debug.Printの出力結果

期待通りの小計が取得できていることが確認できます。

５　とある信用金庫さんへの悩みを解決する

もう一度、処理対象の表を確認します。

次の条件でcrから範囲を取得します。
１　預金金額は１以上
２　預金額が3000円の場合は除く

ではコードに落とし込んでいきましょう！

Sub cr_Subtotal2()

    Dim cr As Range: Set cr = Range("A1").CurrentRegion
    Dim i As Long, myRnge As Range
    Dim targetRange1 As Range
    Dim taget1_Subtotal
    Dim rangeCount As Long
    
    For i = 2 To cr.Rows.Count
        '預金額が１以上
        If cr.Cells(i, 3) > 1 Then
            '預金額が3000円で無い場合
            If Not cr.Cells(i, 3) = 3000 Then
                If targetRange1 Is Nothing Then
                    Set targetRange1 = cr.Rows(i)
                Else
                    Set targetRange1 = Union(targetRange1, cr.Rows(i))
                End If
            End If
        End If
    Next
    
    '3000円の列以外が選択できていることが確認できる。
    targetRange1.Select
    
    '小計を取得する。
    If Not targetRange1 Is Nothing Then: taget1_Subtotal = 0
        For Each myRnge In targetRange1
            rangeCount = rangeCount + 1
            If rangeCount = 3 Then
                taget1_Subtotal = taget1_Subtotal + myRnge.Value
                rangeCount = 0
            End If
        Next
    
    Debug.Print taget1_Subtotal

End Sub

IF文で預金額が１以上かつ、3000円以上の場合、targetRange1にSetします。
targetRange1.Selectで、3000円以外のセルが選択できていることが確認できます。
小計は、ごめんなさいSumで簡単に取れなかったので、苦肉の策で「For　each　in　next」でループして、変数rangeCount ＝３（預金額のデータの時）に変数taget1_Subtotal に預金額を足して小計を出しています。もっとスマートな方法は考えておきますm(_ _"m)。

Debug.Printの結果

きちんと3000円以外の小計が取れています。ちなみに、変数taget1_Subtotal はVariant型にしてます。Long型でもオーバーフローするとのことだったので。

ちなみに、targetRange1.Selectをした時の画像↓↓

預金額が3000円以上の行が選択されています。

改良版

改良コード↓↓

Sub cr_Subtotal2_Ver2()

    Dim cr As Range: Set cr = Range("A1").CurrentRegion
    Dim i As Long, myRnge As Range
    Dim targetRange1 As Range, targetCountRange1 As Range
    Dim taget1_Subtotal
    Dim rangeCount As Long
    
    For i = 2 To cr.Rows.Count
        '預金額が１以上
        If cr.Cells(i, 3) > 1 Then
            '預金額が3000円で無い場合
            If Not cr.Cells(i, 3) = 3000 Then
                If targetRange1 Is Nothing Then
                    Set targetRange1 = cr.Rows(i)
                    Set targetCountRange1 = cr.Cells(i, 3)
                Else
                    Set targetRange1 = Union(targetRange1, cr.Rows(i))
                    Set targetCountRange1 = Union(targetCountRange1, cr.Cells(i, 3))
                End If
            End If
        End If
    Next
    
    '3000円の行以外の列Cが選択できていることが確認できる。
    targetCountRange1.Select
    
    '条件にあった預金額の小計を取る。
    If Not targetRange1 Is Nothing Then taget1_Subtotal = WorksheetFunction.Sum(targetCountRange1)
    
    Debug.Print taget1_Subtotal

End Sub

変数targetCountRange1 を追加しました。これは、預金額の部分のみの範囲を取得します。
よって、変数taget1_Subtotal にSum関数で一発で小計が取得できます。
少しだけスマートになりました！

６　感想

いや～、複数のcrを選択した場合、cr.Rows.Count＝２になってしまうことに気づきました(;^ω^)
行１３まで選んでくれると思ったら、途切れたセルの範囲は取得してくれませんでした(´;ω;｀)
とりあえず、やっつけで「For　each　in　next」作ってみました。
とある信用金庫さん、参考にならなかったらすんませんm(_ _"m)
crの極意をもっと勉強します。

ではでは、この辺で(^^)/~~~