Преброяване на различни стойности в избран (голям) диапазон във 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();