Policz liczbę różnych wartości w wybranym (dużym) zakresie w VBA?

Question

Jak mogę policzyć liczbę różnych wartości (liczby i ciągi mieszane) w wybranym (dużym) zakresie w VBA?

Myślę o tym w ten sposób:
1. Odczytywanie danych w jednowymiarowej tablicy.
2. Sortuj tablicę (sortowanie szybkie lub scalone) należy przetestować, aby uzyskać informacje o liczbie różnych wartości, jeśli posortowana tablica: if(a[i]<>a[i+1]) then counter=counter+1.

Czy jest to najbardziej skuteczny sposób na rozwiązanie tego problemu?

Edytuj: Chcę to zrobić w programie Excel.

Answer 1

Oto rozwiązanie VBA

Nie potrzebujesz matrycy, aby to zrobić. Możesz także użyć kolekcji. Przykład

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 

nawiązanie

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

Niestety, jest to napisane w języku C#. Tak właśnie bym to zrobił.

// 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 

Nie testowałem tego, spróbuj.

Powinieneś zawinąć to wewnątrz metody, aby nie było problemów z śmieciami. W przeciwnym razie utracisz kopię tablicy dopiero później. (return count)

EDYCJA: Potrzebujesz listy, aby to działało, użyj Array.ToList();

Answer 3

Zamiast kroków 2 i 3, być może warto użyć wartości Scripting.Dictionary i dodać każdą wartość do słownika. Wszelkie duplikaty wpisów powodowałyby błąd runtime, który można albo przechwycić, albo zignorować (resume next). Na koniec możesz po prostu zwrócić słownik count, który da ci liczbę unikalnych wpisów.

Oto kawałek kodu I pośpiesznie wyrzucił razem:

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 

wiem, że resume next można uznać za „zapachy kodu”, ale alternatywą może być użycie funkcji exists słownika, aby sprawdzić, czy określony klucz już istnieje, a następnie dodaje wartość, jeśli nie. Po prostu mam wrażenie, że kiedy robiłem coś podobnego w przeszłości, to było tak, że po prostu zignorowałem wszystkie błędy wywołane dla duplikatów kluczy, zamiast używać exists YMMY. Dla kompletności, tutaj jest inna metoda z użyciem 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 

Chociaż powyższy kod jest prostszy niż proponowanej metody, warto byłoby, aby przetestować działanie przeciwko nim rozwiązania.

Answer 4

Opierając się na idei prezentowanych przez i_saw_drones, gorąco polecam Scripting.Dictionary. Można to jednak zrobić bez widocznego poniżej obrazu: On Error Resume Next. Również jego przykład wymaga połączenia biblioteki Microsoft Scripting Runtime. Mój przykład zademonstruje, jak to zrobić, bez konieczności wykonywania jakichkolwiek powiązań.

Ponadto, ponieważ robisz to w programie Excel, nie musisz w ogóle tworzyć tablicy w kroku 1. Poniższa funkcja zaakceptuje zakres komórek, które zostaną całkowicie powtórzone.

(tj UniqueCount = UniqueEntryCount(ActiveSheet.Cells) lub 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 

Może być również ważne, aby zauważyć, że powyższe zlicza łańcuch pusty "" jako odrębna wartość. Jeśli nie chcesz, aby tak się stało, po prostu zmień kod na:

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