获得独特的价值观以及在Excel VBA中的空字符串

Question

如何修改这个代码也给空字符串范围

Sub GetUniqueAndCount() 

    Dim d As Object, c As Range, k, tmp As String 

    Set d = CreateObject("scripting.dictionary") 
    For Each c In Selection 
     tmp = Trim(c.Value) 
     If Len(tmp) > 0 Then d(tmp) = d(tmp) + 1 
    Next c 

    For Each k In d.keys 
     Debug.Print k, d(k) 
    Next k 

End Sub 

Answer 1

只需删除测试TMP的长度，它应该做的它：

Sub GetUniqueAndCount() 

    Dim d As Object, c As Range, k, tmp As String 

    Set d = CreateObject("scripting.dictionary") 
    For Each c In Selection 
     tmp = Trim(c.Value) 
     d(tmp) = d(tmp) + 1 
    Next c 

    For Each k In d.keys 
     Debug.Print k, d(k) 
    Next k 

End Sub