カウント値の出現私のVBAプログラムで辞書

Question

をループせずに私は辞書

Dim dic As Variant 
Set dic = CreateObject("Scripting.Dictionary") 

を持っている私はいくつかの値に""

例を持っている文字列アイテムの束を（のは、100を言わせて）追加しています：

Key | Value 
------------------- 
    "A" | 1 
    "B" | "" 
    "C" | 3 
    "D" | 4 
    "E" | "" 
etc. 

私はdic.Count("A")でキー発生回数をカウントする方法がある知っているが、私はどのように多くの項目でカウントしたいです私の辞書には値""（私の例では2）があり、各項目をループしません。

私は成功せず、次のことを試してみました：

これを達成することができる方法

MsgBox "dic.item()count=" & dic.Item("").Count 
MsgBox "dic.item()count=" & dic("").Count 

？ dic.Value("").Countのような方法はありますか？

Answer 1

これは醜いですが、それはループではありません。

結局のところ、この方法でも超大型の辞書のために非常に迅速に動作します。いくつかの小さなロジックエラーを修正するためにいくつかの編集（スプリットは、引数の数が間違ったと、それはゼロベースの配列であることから、1を減算する必要はありません）

はまた、私がテストメイド

'Convert the Dictionary to an Array 
MyArray = dic.Items 
'Convert the Array to a String 
MyString = Join(MyArray, ";") 
'Blank Items in the Dictionary will result in ";;" appearing in the String 
'Split the String on ;; 
MyArray = Split(MyString, ";;", -1, vbTextCompare) 
'A String with no ";;"'s will result in a 1 element array 
'A String with 2 occurances of ;; will give a 3 element array 
NumberOfBlankItems = UBound(MyArray) 

20,000要素の辞書であり、辞書をループするときとこの方法との間には大きな違いはありません。私が思ったようたぶんそのように醜いない...

---

私はこのコードを使用して1つの以上のテストでした：あなたも、見ることができるように

Starting count by looping: 6/15/2016 3:02:47 PM 
Count by looping: 818 
Starting count by splitting: 6/15/2016 3:03:16 PM 
Count by splitting: 818 
Finish time: 6/15/2016 3:03:16 PM 

：

Sub DictionaryTest() 
    Dim dic As New Dictionary 'Variant 
    Dim r As Long 
    Dim key As Variant 
    Dim myArray As Variant 
    Dim mystring As String 
    Dim NumberOfBlankItems As Integer 

    Set dic = CreateObject("Scripting.Dictionary") 
    For r = 1 To 500000 
     dic.Add "Key " & r, CInt(Int((600 * Rnd()) + 1)) 
    Next 

    r = 0 

    Debug.Print "Starting count by looping: " & Now() 

    For Each key In dic 
     If dic.item(key) = 300 Then r = r + 1 
    Next 

    Debug.Print "Count by looping: " & r 

    Debug.Print "Starting count by splitting: " & Now() 

    myArray = dic.Items 
    mystring = Join(myArray, ";") 
    myArray = Split(mystring, "300;", -1, vbTextCompare) 
    NumberOfBlankItems = UBound(myArray) 
    Debug.Print "Count by splitting: " & NumberOfBlankItems 

    Debug.Print "Finish time: " & Now() 
End Sub 

イミディエイトウィンドウを辞書に500,000のエントリがあると、文字列を分割するのにかかる時間（約20億文字以下の文字列）はまだ約1秒です。