|
こんな感じで、どうでしょーか ?
Sub MyCount()
Dim MyR As Range
Dim Flg As Boolean
With Range("A:A").SpecialCells(2).Areas
If .Count > 1 Then .Item(2).Resize(, 2).ClearContents
End With
Set MyR = Range("A1").CurrentRegion
If MyR.ListHeaderRows = 0 Then
Flg = True: Application.ScreenUpdating = False
Rows(1).Insert xlShiftDown
Range("A1").Value = "[COUNT]"
End If
Range("A1", Range("A65536").End(xlUp)).AdvancedFilter _
xlFilterCopy, , Range("A65536").End(xlUp).Offset(2), True
With Range("A65536").End(xlUp).CurrentRegion
.Offset(, 1).Formula = _
"=COUNTIF(" & MyR.Address & "," & .Range("A1").Address(0, 0) & ")"
.Offset(, 1).Value = .Offset(, 1).Value
.Offset(, 1).Range("A1").ClearContents
End With
If Flg Then
Rows(1).Delete xlShiftUp
Application.ScreenUpdating = True
End If
Set MyR = Nothing
End Sub
|
|