|
例えばA,B列どちらのデータにも、カンマが含まれていなければ、
このように変更します。
Sub MyCount2()
Dim MyR As Range, C As Range
Dim Flg As Boolean
Dim x As Integer
Application.ScreenUpdating = False
With Range("A:A").SpecialCells(2).Areas
If .Count > 1 Then .Item(2).Resize(, 2).ClearContents
End With
Set MyR = Range("A1").CurrentRegion
For Each C In MyR
C.Value = C.Value & "," & C.Offset(, 1).Value
Next
If MyR.ListHeaderRows = 0 Then
Flg = True
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
For Each C In MyR
x = InStr(1, C.Value, ",")
If x > 0 Then C.Value = Left$(C.Value, x - 1)
Next
Application.ScreenUpdating = True: Set MyR = Nothing
End Sub
|
|