|
▼chou さん:
一番が複数の場合、どれでもよいなら。
本題のセル範囲の指定方法は
γさんのコードをそのまま利用させていただき
最大値を求めるところは、
「統合」と「並べ替え」を使ってみました。
Sub test()
Dim rng As Range
Dim constAreas As Areas
Dim blankAreas As Areas
Dim r As Range
Dim k As Long
Dim c As Range
Set rng = Range("C1:C15") 'end等を使って調整のこと
Set constAreas = rng.SpecialCells(xlCellTypeConstants).Areas
Set blankAreas = rng.SpecialCells(xlCellTypeBlanks).Areas
Set c = Range("Z1") 'どこか離れた場所を作業用に使用(統合先)
For Each r In constAreas
c.Consolidate r.Resize(, 2).Address(, , xlR1C1), xlSum, False, True
c.CurrentRegion.Sort c.Columns(2), xlDescending
k = k + 1
blankAreas(k).Value = c.Value
c.CurrentRegion.ClearContents
Next
End Sub
|
|