|
こんにちは
>まず、そういうことはありません。
と考えて
お試しを(Errの処理はしていません)
該当シートを「Sheet1」としています。
Sub Test()
Dim R As Range, C As Range, Ro As Long
Ro = 2
Application.ScreenUpdating = False
With Worksheets("Sheet1")
.Range("A1").Sort Key1:=.Range("A2"), Order1:=xlAscending, Key3:=.Range("N2") _
, Order3:=xlAscending, Header:=xlGuess
.Range("A1").Subtotal GroupBy:=1, Function:=xlMax, TotalList:=Array(14), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Set R = .Range("M2:M" & .Range("N65536").End(xlUp).Row - 1).SpecialCells(xlCellTypeBlanks)
For Each C In R
.Cells(Ro, 15).Resize(C.Row - Ro).Formula = _
"=IF(" & C.Offset(, 1).Address & "=" & "N" & Ro & ","""",1)"
.Cells(Ro, 15).Resize(C.Row - Ro).Value = .Cells(Ro, 15).Resize(C.Row - Ro).Value
Ro = C.Row + 1
Next C
.Columns(15).SpecialCells(xlCellTypeConstants).EntireRow.Delete
.Range("A1").RemoveSubtotal
Set R = Nothing
End With
Application.ScreenUpdating = True
End Sub
|
|