algorithm - 计算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

Instead of steps 2 and 3, perhaps you could use a Scripting.Dictionary and add each value to the dictionary. Any duplicate entries would cause a runtime error which you could either trap or ignore (resume next). Finally, you could then just return the dictionary's count which would give you the count of unique entries.

Here's a scrap of code I hurriedly threw together:

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

I know that resume next can be considered a 'code smell', but the alternative could be to use the exists function of the dictionary to test whether the specified key already exists and then add the value if did not. I just have a feeling that when I did a similar thing in the past that it was faster to just ignore any errors raised for duplicate keys rather than using exists YMMY. For completeness, here's the other method using 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

Whilst the above code is simpler than your proposed method, it would be worth to test the performance of it against your solution.

Answer 3

基于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

Answer 4

抱歉，这是用 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();