| 
    
     |  | ▼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
 
 
 |  |