空白行から空白行までの合計値とその間の最大値の算出方法について

エクセルに入力されている数値表です。
数行ごとに1行の空白行があり、それをブロックと呼ぶ事にします。
そのブロックのBF列にある数値をブロックごとに集計し、そのブロックの最大値の割合を出す良い方法（関数やマクロ）を教えていただけないでしょうか。計算値はBF列、BG列でなくても構いません。よろしくお願いします。

　　　　BF列
　　　5
　　　7→最大値
　　　2
　　　4
　　　6
　　　 6
（空白行）計30、7/30→（この「30､0.233」がほしい）
　　　　　4
　　　　　3
　　　　　5
　　　　　6→最大値
（空白行）計18、6/18→（この「18､0.333」がほしい）

No.4 ベストアンサー 回答者： GooUserラック 回答日時： 2020/03/02 18:43

No.2 の補足

・BF列にタイトル行などがあった場合は「For 対象行 = 1 To 最終行」の「1」を適当に変更して下さい。

・また先頭が空欄だったり、2行以上空欄が続くことが有るなら以下のようにしてください。
　（最終行を「1」加えてループ後の処理を不要にもしています）

Sub Sample()

Dim 合計 As Variant
Dim 最大 As Variant
Dim 対象行 As Long
Dim 最終行 As Long

　最終行 = Cells(Rows.Count, 58).End(xlUp).Row + 1
　For 対象行 = 1 To 最終行
　　If Cells(対象行, 58).Value = "" Then
　　　If 合計 <> 0 Then
　　　　Cells(対象行, 58).Value = 合計
　　　　Cells(対象行, 59).Value = 最大 / 合計
　　　　最大 = 0
　　　　合計 = 0
　　　End If
　　Else
　　　合計 = 合計 + Cells(対象行, 58).Value
　　　If 最大 < Cells(対象行, 58).Value Then 最大 = Cells(対象行, 58).Value
　　End If
　Next

End Sub

この回答へのお礼

タイトル行が問題だったのですね。ありがとうございます。求める結果が得られました。助かりました。

お礼日時：2020/03/02 19:01

No.3 回答者： めぐみん_ 回答日時： 2020/03/02 18:32

一例です。

ＢＦ・ＢＧに結果を出してます。

Sub try()
Dim r As Range

For Each r In Range("BF1", Cells(Rows.Count, "BF").End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers).Areas

With WorksheetFunction
r.Offset(r.Rows.Count).Resize(1, 2).Value = _
Array(.Sum(r), Int(.Max(r) / .Sum(r) * 1000) / 1000)
End With

Next

End Sub

この回答へのお礼

ありがとうございます。求める結果が得られました。申し訳ありませんが、先に御回答いただいた方をベストアンサーとさせていただきます。

お礼日時：2020/03/02 19:02

No.2 回答者： GooUserラック 回答日時： 2020/03/02 18:10

マクロでしたらこんな感じでしょうか？

Sub Sample()

Dim 合計 As Variant
Dim 最大 As Variant
Dim 対象行 As Long
Dim 最終行 As Long

　最終行 = Cells(Rows.Count, 58).End(xlUp).Row
　For 対象行 = 1 To 最終行
　　If Cells(対象行, 58).Value = "" Then
　　　Cells(対象行, 58).Value = 合計
　　　Cells(対象行, 59).Value = 最大 / 合計
　　　最大 = 0
　　　合計 = 0
　　Else
　　　合計 = 合計 + Cells(対象行, 58).Value
　　　If 最大 < Cells(対象行, 58).Value Then 最大 = Cells(対象行, 58).Value
　　End If
　Next
　Cells(対象行, 58).Value = 合計
　Cells(対象行, 59).Value = 最大 / 合計

End Sub

この回答へのお礼

御回答ありがとうございます。以下のメッセージで中断します。再度アドバイスいただけないでしょうか。


実行時エラー'13':
型が一致しません。

合計 = 合計 + Cells(対象行, 58).Value（→この部分が黄色で示されています）

お礼日時：2020/03/02 18:36

No.1 回答者： 銀鱗 回答日時： 2020/03/02 18:07

一つずつROWS関数とMAX関数にセルの範囲を設定すれば良いと思うんだ。

1000個の範囲があっても、1時間くらいあれば終わるだろ？

Shiftキーを押しながら↓キーを押せば、連続した範囲を選択できる。
（Shift+↓）
Ctrlキーを押しながら↓キーを押すと、アクティブだったセルと同じ状態（空か空でないか）の最後のセルまでジャンプする。
（Ctrl＋↓）
この組み合わせを使えば、値が入力されている範囲を一瞬で指定できる。
（Shift+Ctrl+↓）
がんばれ。

この回答へのお礼

御回答ありがとうございます。参考にさせていただきます。

お礼日時：2020/03/02 18:37