可変する範囲の合計を出したい（マクロ）

質問

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

Ａ　…　Ｃ　　　Ｄ … 　Ｇ
NO.　　順位　　社名　　金額
1　　　　1　　　　Ａ　　　800
2　　　　2　　　　Ｂ　　　700
3　　　　3　　　　Ｃ　　　600
4　　　　3　　　　Ｄ　　　600
5　　　　4　　　　Ｅ　　　500
:　　　　　:　　　　:　　　　:
:　　　　　:　　　　:　　　　:
253　　120　　　Ｍ　　　100
254　　120　　　Ｗ　　　100
合計欄 （100位までの合計金額が入る）

254社まであり、1位から順に総金額を基準に順位がふってあります。
総金額が同じ会社は順位も同じになります。
なので、たとえば100位が10社ある場合もあります。
また、必ずしも100位までとは限りません。順位とNO.が連動している関係から、85位の次が112位という場合もあります。
このような表で、1位から100位以下の会社の合計金額をマクロで計算するにはどうすればよいのでしょうか？
順位は都度変わるので、合計する範囲も常に変わります。
*************************************************
Dim i As Integer
For i = 7 To 254
Cells(i, "C").Select
If Cells(i, "C") >= 101 then 'もし101以上だったら
Cells(i, "C").Offset(1, 0).Select '一行下へ移動する※
ElseIf Cells(i, "C") <= 100 then 'もし100以下だったら

End If
Next
End Sub
*************************************************
ここまで書いて、次の作業に悩んでいます。

Elself～のあとに、
ActiveCell.Interior.ColorIndex = 3
ActiveCell.Offset(0, 4).Select
ActiveCell.Interior.ColorIndex = 5
と入れると、C列とG列の100位以下の合計したい範囲に色がつきました。
これを利用して範囲指定すればいいのかな？と思いましたが、どうもうまくいきません。
都度変わる範囲を指定してSUM関数と組み合わせるにはどうすればよいのでしょうか？

回答No.1

hana-hana3 · ベストアンサー

SumIF関数

合計 = Application.WorksheetFunction.SumIf(Range("C2:C255"), "<=100", Range("G2:G255"))

お礼

早速の回答ありがとうございます！
SUMIF関数、全然頭から抜けてました～～。

Application.WorksheetFunction　のあとに関数を書くのですね。
ありがとうございました！！

回答No.3

Wendy02

こんばんは。

私の作ったものは出来が悪いかもしれませんが、私もやってみました。

基本的には、関数でも可能なようにユーザー定義関数にしてみました。

　=mySumIf(C2:C250,G2:G250,">=1","<=100")

例えば、このようにすると、出てきます。1 以上、100 以下の場合です。

　=mySumIf(C2:C250,G2:G250,">1")

こうすれば、通常のSumIf と同じです。

それを以下のようにマクロに組みました。
データ範囲は、A1 から、データ続きの範囲のCurrentRegion の範囲を自動的に取得しています。出力先は、計算範囲の最後の行の次です。

'標準モジュールに設定してください。
'--------------------------------------------------------------------------

Sub Main()
Dim r As Range
Dim ret As Variant　'エラー値排出のため、Variant
　Const MATCHCOL As Variant = "C"
　Const TOTALCOL As Variant = "G"
　Const Crit_1 As String = ">=1" '第1条件
　Const Crit_2 As String = "<=100" '第2条件 第1条件よりも、数字は大きいこと
　'注意:　Crit_2 を入れる場合は論理的な組み合わせしかありません。
　 Set r = ActiveSheet.Range("A1").CurrentRegion
　 ret = mySumIf(r.Columns(MATCHCOL), r.Columns(TOTALCOL), Crit_1, Crit_2)
　 '出力先、計算範囲の最後の行の次
　 With ActiveSheet.Cells(r.Rows.Count, TOTALCOL)
　　　.Offset(1, -2).Value = Crit_1　'第1条件1
　　　.Offset(1, -1).Value = Crit_2　'第2条件1
　　　.Offset(1).Value = ret
　　　.Offset(1).Select
　 End With
　 Set r = Nothing
End Sub

'--------------------------------------------------------
'単独で使用できます。
Public Function mySumIf(MatchRange As Range, TotalRange As Range, Optional Crit_1 As String = "", Optional Crit_2 As String = "")
　'MatchRange =検索範囲, TotalRange =計算範囲, Crit_1 =第1条件, Crit_2=第2条件

　Dim ret1 As Double
　Dim ret2 As Double
　Dim ret As Double
　Dim ope1 As String
　Dim ope2 As String
　Dim ope As String
　Dim fig As Double

　'注意：CRIT_2 を入れる場合は論理的な組み合わせしかありません。
　' >a (以上) <(以下)　のような範囲でくくります。それ以外は正しい値が出ません。

　 On Error GoTo ErrHandler
　　ret1 = WorksheetFunction.SumIf(MatchRange, Crit_1, TotalRange)

　　'演算子の反転
　　If Crit_2 <> "" Then
　　　Select Case Left(Crit_2, 1)
　　　　Case "<"
　　　　　ope1 = ">"
　　　　Case ">"
　　　　　ope1 = "<"
　　　　Case Else
　　　　　ope1 = ""
　　　End Select
　　　Select Case Mid(Crit_2, 2, 1)
　　　　Case "="
　　　　　ope2 = ""
　　　　　fig = Mid(Crit_2, 3)
　　　　Case Else
　　　　　ope2 = "="
　　　　　fig = Mid(Crit_2, 2)
　　　End Select
　　　ope = ope1 & ope2
　　　ret2 = WorksheetFunction.SumIf(MatchRange, ope & fig, TotalRange)
　　End If
　　ret = ret1 - ret2
　　mySumIf = ret
　　Exit Function
ErrHandler:
　 'エラー排出
　 mySumIf = CVErr(xlErrNA)
End Function

お礼

回答ありがとうございます。
教えていただいた記述について、ヘルプとつき合わせながらにらめっこしているところです。
私にはなかなか高度で、教わってすぐ理解できました！とはご報告できませんが、時間をかけて一つ一つじっくりとやっていきたいと思います。
どうもありがとうございました。

回答No.2

noname#22222

NO.　　順位　　社名　　金額
1　　　　1　　　　A　　　　10
2　　　　1　　　　B　　　　10
3　　　　3　　　　C　　　　9
4　　　　3　　　　D　　　　9
5　　　　5　　　　E　　　　8
　　　　　　　　　　　　　<38>

と少し簡略にして順位４位未満を塗りつぶしには、

Private Sub CommandButton2_Click()
　　Dim I As Integer
　　Dim L As Integer
　　Dim S As Long

　　For I = 2 To 6
　　　　L = Abs(Cells(I, 2) < 4)
　　　　Cells(I, 2).Interior.ColorIndex = 3 * L
　　　　Cells(I, 4).Interior.ColorIndex = 5 * L
　　　　S = S + Cells(I, 4) * L
　　Next I
　　Cells(7, 4) = S
End Sub

これで、仮にNo4の順位を4に変更すればC社までしか塗りつぶされません。
合計も計算されます。

お礼

早速の回答ありがとうございます！

◆Abs(Cells(I, 2) < 4)

初心者用のVBAサイトをいろいろ見ているのですが、このような書き方は初めて見ました。
あと、ColorIndex = 3 * L　の　* L　の部分も・・・！
とても勉強になりました。ありがとうございます。

◆S = S + Cells(I, 4) * L

ここの「S + 」の部分がわからないのですが、合計欄のセル番地をプラスしないと合計値が出ないのは何故なのですか？
お時間のあるときに教えていただければ幸いです。
よろしくお願い致します。