Sub f()

Set myb = CreateObject("scripting.dictionary"): myb("PICSID") = "出現次數"
Set Rng = Application.InputBox("選擇統計區域:", Type:=8)
ActiveSheet.Cells.Interior.ColorIndex = 0
Rng.Interior.ColorIndex = 3

For Each rng1 In Rng
    myb(rng1.Value) = Application.WorksheetFunction.CountIf(Rng, rng1)
Next

Set rng3 = Application.InputBox("選擇輸出地方：", Type:=8)

With rng3
    .Resize(myb.Count) = Application.Transpose(myb.keys)
    .Offset(, 1).Resize(myb.Count) = Application.Transpose(myb.items)
End With

Set myb = Nothing: Set rng3 = Nothing

End Sub