Подсчитать количество разных значений в выбранном (большом) диапазоне в VBA?

Вот решение 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

Вместо шагов 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

Хотя приведенный выше код проще, чем предложенный вами метод, было бы целесообразно проверить его производительность в сравнении с вашим решением.

Основываясь на идее, представленной i_saw_drones, я настоятельно рекомендую Scripting.Dictionary. Однако это можно сделать и без On Error Resume Next, как показано ниже. Кроме того, его пример требует линковки библиотеки Microsoft Scripting Runtime. Мой пример продемонстрирует, как это сделать без необходимости связывания.

Кроме того, поскольку вы делаете это в Excel, вам вообще не нужно создавать массив на шаге 1. Функция ниже примет диапазон ячеек, которые будут полностью перебираться.

(i.e. UniqueCount = UniqueEntryCount(ActiveSheet.Cells) or 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

Извините, это написано на 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();