|
こんにちは。
覚え立てのDictionaryを使って、合計までは出せたのですが、
件数をどこで取得したらいいかわかりません。情けない。
識者の回答をお待ちください。
Sub test2()
Dim myR As Range
Dim myVAl As Variant
Dim myDic As Object
Dim myKey As Variant
Dim i As Long
With Worksheets("Sheet1")
Set myR = .Range("A1", .Range("A65536").End(xlUp))
With myR.Offset(, 26)
.Value = "=IF(COUNTIF(" & myR.Address & ",A1)>1,"""",1)"
On Error Resume Next
.SpecialCells(xlCellTypeFormulas, xlNumbers).EntireRow.Delete
If Err.Number <> 0 Then
MsgBox "重複セルはありません"
Err.Clear
End If
On Error GoTo 0
.ClearContents
End With
myVAl = myR.Resize(, 2).Value
Set myDic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(myVAl, 1)
myKey = myVAl(i, 1)
myDic.Item(myKey) = myDic.Item(myKey) + myVAl(i, 2)
Next
' End With 'Sheet2に書き出す場合
' With Worksheets("Sheet2") 'Sheet2に書き出す場合
.Cells.ClearContents
With .Range("A1").Resize(myDic.Count)
.Value = Application.Transpose(myDic.Keys())
.Offset(, 1).Value = Application.Transpose(myDic.Items())
End With
End With
Set myR = Nothing
Set myDic = Nothing
End Sub
|
|