vba字典重复key,键值对，通过字典vba循环

I am trying to read a column one cell at a time and store it the cell as a key and its frequency as its value. Then I want to place all key-value pairs into a range say column P and Q. I think I got the first part of the job done with the code below (not 100% on it though) Now how can place the key value pairs to a range?

Dim D As Dictionary

Set D = New Dictionary

Dim DR As Range

Set DR = Range(Cells(2, 2), Cells(2, 2).End(xlDown))

For Each Cell In DR.Cells

If Not D.Exists(Cell.Value) Then

D.Add Cell, 1

Else

D.Exists (Cell.Value)

D.Item(Cell.Value) = D.Item(Cell.Value) + 1

End If

Next Cell

I roughly have the idea of looping through the dictionary per each key but I cant do

Dim k as key

any help is much appreciated

解决方案

Try below code :

Sub test()

Dim D As Dictionary

Set D = New Dictionary

Dim DR As Range

Dim lastRow As Long

lastRow = Range("A65000").End(xlUp).Row

Set DR = Range("A2:A" & lastRow)

For Each Cell In DR

If D.Exists(CStr(Cell.Value)) = False Then

D.Add CStr(Cell.Value), 1

Else

D.Exists (Cell.Value)

D.Item(Cell.Value) = D.Item(Cell.Value) + 1

End If

Next

i = 2

For Each Key In D

Range("P" & i).Value = Key

Range("Q" & i).Value = D(Key)

i = i + 1

Next

End Sub