Contare il numero di valori diversi nell'intervallo scelto (grande) in VBA?

Question

Come posso contare il numero di valori diversi (numeri e stringhe misti) in un intervallo (grande) scelto in VBA?

Ci penso in questo modo:
1. Leggere i dati in un array monodimensionale.
2. Ordinare array (ordinamento rapido o di unione) per testare quale
3. Contare semplicemente il numero di valori diversi se array ordinato: if(a[i]<>a[i+1]) then counter=counter+1.

È il modo più efficace per risolvere questo problema?

Modifica: voglio farlo in Excel.

Answer 1

Ecco una soluzione di VBA

Non è necessario una matrice per ottenere questo fatto. Puoi anche usare una collezione. Esempio

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 

FOLLOWUP

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

Spiacente, questo è scritto in C#. Questo è come lo farei.

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

Non l'ho provato, per favore prova.

Si dovrebbe racchiudere questo in un metodo in modo che non ci siano problemi con la spazzatura. Altrimenti si perderebbe la copia dell'array solo successivamente. (conteggio di ritorno)

MODIFICA: è necessario un elenco per farlo funzionare, utilizzare Array.ToList();

Answer 3

Invece dei passaggi 2 e 3, è possibile utilizzare uno Scripting.Dictionary e aggiungere ogni valore al dizionario. Qualsiasi voce duplicata causerebbe un errore di runtime che potreste intercettare o ignorare (resume next). Infine, puoi semplicemente restituire il dizionario count che ti darà il conteggio delle voci univoche.

Ecco un pezzo di codice che ho fretta gettato insieme:

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 

so che resume next può essere considerato un 'codice di odore', ma l'alternativa potrebbe essere quella di utilizzare la funzione exists del dizionario per verificare se la chiave specificata esiste già e quindi aggiunge il valore in caso contrario. Ho la sensazione che quando ho fatto una cosa simile in passato era più veloce ignorare qualsiasi errore generato per chiavi duplicate piuttosto che usare exists YMMY. Per completezza, ecco l'altro metodo che utilizza 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 

Mentre il codice di cui sopra è più semplice di quanto il tuo metodo proposto, sarebbe la pena di testare le prestazioni di esso contro la vostra soluzione.

Answer 4

costruzione sull'idea presentata da i_saw_drones, vi raccomando vivamente il Scripting.Dictionary. Tuttavia, questo può essere fatto senza On Error Resume Next come mostrato di seguito. Inoltre, il suo esempio richiede il collegamento della libreria Microsoft Scripting Runtime. Il mio esempio dimostrerà come farlo senza dover fare alcun collegamento.

Inoltre, poiché si sta facendo questo in Excel, non è necessario creare l'array nel passaggio 1. La funzione seguente accetterà un intervallo di celle, che verrà completamente iterato.

(cioè UniqueCount = UniqueEntryCount(ActiveSheet.Cells) o 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 

Potrebbe anche essere importante notare che quanto sopra conterà una stringa nulla "" come un valore distinto. Se non si desidera che questo sia il caso, è sufficiente modificare il codice a questo:

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