### 在VBA中選擇(大)范圍內不同值的個數?

#### [英]Count number of different values in chosen (large) range in VBA?

How can I count the number of different values (numbers and strings mixed) in a chosen (large) range in VBA?

1. Read in data into one dimensional array.
2. Sort array (quick or merge sort) need to test which
3. Simply count number of different values if sorted array : `if(a[i]<>a[i+1]) then counter=counter+1`.

Is it the most efficient way to solve this problem?

Edit: I want to do it in Excel.

## 4 个解决方案

### #1

7

Here is a VBA Solution

You don't need an Array to get this done. You can also use a collection. Example

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

### #2

4

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)

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.

### #3

3

Building on the idea presented by i_saw_drones, I strongly recommend the `Scripting.Dictionary`. However, this can be done without `On Error Resume Next` as shown below. Also, his example requires linking the `Microsoft Scripting Runtime` library. My example will demonstrate how to do this without needing to do any linking.

Also, since you're doing this in Excel, then you don't need to create the array in step 1 at all. The function below will accept a range of cells, which will be iterated through completely.

(i.e. `UniqueCount = UniqueEntryCount(ActiveSheet.Cells)` or `UniqueCount = UniqueEntryCount(MySheet.Range("A1:D100")`)

(即unique ecount = UniqueEntryCount(ActiveSheet.Cells)或uniquecentrycount (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
End If
Next l2
Next l1

UniqueEntryCount = dic.Count
Set dic = Nothing
End Function
``````

It might also be important to note that the above will count a null string `""` as a distinct value. If you do not want this to be the case, simply change the code to this:

``````    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
End If
Next l2
Next l1
``````

### #4

0

Sorry this is written in C#. This is how I would do it.

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

Have not tested it, please try.

You should wrap this inside a method so there is no messing around with the garbage. Otherwise you would lose the copy of the array only later. (return count)

EDIT: You need a list for this to work, use Array.ToList();