在VBA中選擇（大）範圍內計算不同值的數量？

Question

如何計算VBA中所選（大）範圍內的不同值（數字和字符串混合）的數量？

我這樣想：
1.將數據讀入一維數組。
2.排序陣列（快速或排序合併）需要測試，如果排序陣列
3.只需計數不同值的數目：if(a[i]<>a[i+1]) then counter=counter+1。

它是解決這一問題的最有效方法是什麼？

編輯：我想這樣做在Excel中。

Answer 1

這裏是一個VBA解決方案

你不需要一個數組來完成這件事。你也可以使用一個集合。例如

Sub Samples() 
    Dim scol As New Collection 

    With Sheets("Sheet1") 
     For i = 1 To 100 '<~~ Assuming the range is from A1 to A100 
      On Error Resume Next 
      scol.Add .Range("A" & i).Value, Chr(34) & _ 
      .Range("A" & i).Value & Chr(34) 
      On Error GoTo 0 
     Next i 
    End With 

    Debug.Print scol.Count 

    'For Each itm In scol 
    ' Debug.Print itm 
    'Next 
End Sub 

隨訪

Sub Samples() 
    Dim scol As New Collection 
    Dim MyAr As Variant 

    With Sheets("Sheet1") 
     '~~> Select your range in a column here 
     MyAr = .Range("A1:A10").Value 

     For i = 1 To UBound(MyAr) 
      On Error Resume Next 
      scol.Add MyAr(i, 1), Chr(34) & _ 
      MyAr(i, 1) & Chr(34) 
      On Error GoTo 0 
     Next i 
    End With 

    Debug.Print scol.Count 

    'For Each itm In scol 
    ' Debug.Print itm 
    'Next 
End Sub 

Answer 2

對不起，這是用C＃編寫的。這是我的方式。

// first copy the array so you don't lose any data 
List<value> copiedList = new List<value>(yourArray.ToList()); 

//for through your list so you test every value 
for (int a = 0; a < copiedList.Count; a++) 
{ 
    // copy instances to a new list so you can count the values and do something with them 
    List<value> subList = new List<value>(copiedList.FindAll(v => v == copiedList[i]); 

    // do not do anything if there is only 1 value found 
    if(subList.Count > 1) 
         // You would want to leave 1 'duplicate' in 
    for (int i = 0; i < subList.Count - 1; i++) 
     // remove every instance from the array but one 
     copiedList.Remove(subList[i]); 
} 
int count = copiedList.Count; //this is your actual count 

沒有測試過，請嘗試。

所以沒有與垃圾瞎搞你應該把這個包的方法中。否則，以後只會丟失數組的副本。 （返回計數）

編輯：你需要一個列表這個工作，使用Array.ToList（）;

Answer 3

代替步驟2和3，也許你可以使用一個Scripting.Dictionary每個值添加到字典中。任何重複的條目都會導致運行時錯誤，您可能會陷入或忽略（resume next）。最後，你可以直接返回字典的count，這會給你唯一條目的數量。

下面是一個代碼廢料我趕緊扔在一起：

Function UniqueEntryCount(SourceRange As Range) As Long 

    Dim MyDataset As Variant 
    Dim dic As Scripting.Dictionary 
    Set dic = New Scripting.Dictionary 

    MyDataset = SourceRange 

    On Error Resume Next 

    Dim i As Long 

    For i = 1 To UBound(MyDataset, 1) 

     dic.Add MyDataset(i, 1), "" 

    Next i 

    On Error GoTo 0 

    UniqueEntryCount = dic.Count 

    Set dic = Nothing 

End Function 

我知道resume next可以被認爲是一個「代碼味道」，但替代的方法是用字典的exists功能測試是否指定的鍵已經存在，然後添加該值，如果沒有。我只是有一種感覺，當我在過去做過類似的事情時，忽略重複鍵引發的任何錯誤而不是使用exists YMMY會更快。爲了完整起見，這裏使用exists另一種方法：

Function UniqueEntryCount(SourceRange As Range) As Long 

    Dim MyDataset As Variant 
    Dim dic As Scripting.Dictionary 
    Set dic = New Scripting.Dictionary 

    MyDataset = SourceRange 

    Dim i As Long 

    For i = 1 To UBound(MyDataset, 1) 

     if not dic.Exists(MyDataset(i,1)) then dic.Add MyDataset(i, 1), "" 

    Next i 

    UniqueEntryCount = dic.Count 

    Set dic = Nothing 

End Function 

雖然上面的代碼比你提出的方法更簡單，這將是值得來測試它的性能對您的解決方案。

Answer 4

大廈由i_saw_drones提出的想法，我強烈建議Scripting.Dictionary。但是，如下所示，這可以在沒有On Error Resume Next的情況下完成。另外，他的示例需要鏈接Microsoft Scripting Runtime庫。我的示例將演示如何在不需要進行任何鏈接的情況下執行此操作。

此外，由於您在Excel中執行此操作，因此您無需在第1步中創建數組。下面的函數將接受一系列單元格，這些單元格將完全迭代。

（即UniqueCount = UniqueEntryCount(ActiveSheet.Cells)或UniqueCount = UniqueEntryCount(MySheet.Range("A1:D100")）

Function UniqueEntryCount(SourceRange As Range) As Long 
    Dim MyDataset As Variant 
    Dim MyRow As Variant 
    Dim MyCell As Variant 
    Dim dic As Object 
    Dim l1 As Long, l2 As Long 

    Set dic = CreateObject("Scripting.Dictionary") 
    MyDataset = SourceRange 

    For l1 = 1 To UBound(MyDataset) 
     ' There is no function to get the UBound of the 2nd dimension 
     ' of an array (that I'm aware of), so use this division to 
     ' get this value. This does not work for >=3 dimensions! 
     For l2 = 1 To SourceRange.Count/UBound(MyDataset) 
      If Not dic.Exists(MyDataset(l1, l2)) Then 
       dic.Add MyDataset(l1, l2), MyDataset(l1, l2) 
      End If 
     Next l2 
    Next l1 

    UniqueEntryCount = dic.Count 
    Set dic = Nothing 
End Function 

它還可能是重要的要注意的是上面的將計數空字符串""作爲不同的值。如果你不希望這是這種情況，只需將代碼改成這樣：

For l1 = 1 To UBound(MyDataset) 
     For l2 = 1 To SourceRange.Count/UBound(MyDataset) 
      If Not dic.Exists(MyDataset(l1, l2)) And MyDataset(l1, l2) <> "" Then 
       dic.Add MyDataset(l1, l2), MyDataset(l1, l2) 
      End If 
     Next l2 
    Next l1