Posted to microsoft.public.excel.programming
|
|
Create list of duplicated numbers
Forgot to say that the function FindDups will run about twice as fast if it
is compiled to a dll in VB6 with all fast compiler options, so no array
bounds
checking etc.
RBS
"RB Smissaert" wrote in message
...
This works with the free dll dhRichClient3 from Olaf Schmidt
www.datenhaus.de/Downloads/dhRichClient3.zip
and will be very fast:
Function FindDups(arr1 As Variant, _
arr2 As Variant, _
Optional bUniqueDuplicatesOnly As Boolean) As Variant
'will take 2 1-based, 2-D, 1-column arrays
'and produce a 1-based, 2-D, 1-column array
'with the duplicates that are in the first 2 arrays
'optionally get unique duplicates only
'--------------------------------------------------
Dim i As Long
Dim n As Long
Dim cCol1 As cCollection
Dim colDup As cCollection
Dim arrDup
Set cCol1 = New cCollection
Set colDup = New cCollection
cCol1.CompatibleToVBCollection = False
cCol1.UniqueKeys = True
colDup.CompatibleToVBCollection = False
colDup.UniqueKeys = bUniqueDuplicatesOnly
'add arr1 to cCol1
For i = 1 To UBound(arr1)
If cCol1.Exists(arr1(i, 1)) = False Then
n = n + 1
cCol1.Add n, arr1(i, 1)
End If
Next i
'add the duplicates to colDup
If bUniqueDuplicatesOnly Then
For i = 1 To UBound(arr2)
If cCol1.Exists(arr2(i, 1)) Then
If colDup.Exists(arr2(i, 1)) = False Then
colDup.Add arr2(i, 1), arr2(i, 1)
End If
End If
Next i
Else
For i = 1 To UBound(arr2)
If cCol1.Exists(arr2(i, 1)) Then
colDup.Add arr2(i, 1)
End If
Next i
End If
If colDup.Count = 0 Then
FindDups = arrDup
Exit Function
End If
'transfer colDup to an array
ReDim arrDup(1 To colDup.Count, 1 To 1)
For i = 1 To colDup.Count
arrDup(i, 1) = colDup.ItemByIndex(i - 1)
Next i
FindDups = arrDup
End Function
Sub test()
Dim arr1
Dim arr2
Dim arrDup
arr1 = Range(Cells(1), Cells(65535, 1))
arr2 = Range(Cells(3), Cells(65535, 3))
arrDup = FindDups(arr1, arr2, True)
Range(Cells(5), Cells(UBound(arrDup), 5)) = arrDup
End Sub
You could do the same with the standard VB collection, but that will be
slower.
The above FindDup can run in less than a second, depending on the data in
the ranges.
RBS
"J.W. Aldridge" wrote in message
...
I have a string of data (numbers) starting in B6:B10000 and another
in
I6:I10000..
I need a code to search both strings and return any numbers that
appeared in both list. This list of duplicated numbers should start in
S6.
|