Any way to do this faster?
you were looking for reasons not to us it
Well, I am using it now and I am grateful for your code.
Simple, elegant and much faster.
There are probably much more places in my app where I can use it as I often
have to
matchup 2 arrays.
RBS
"Tom Ogilvy" wrote in message
...
I agree that the While loop should be <= but you were looking for reasons
not to us it, so I never got around to saying that.
My code was for 1 based arrays and did check the first values. It was
provided to be illustrative, not a turnkey solution.
--
Regards,
Tom Ogilvy
"RB Smissaert" wrote in message
...
I think this is how it should be if I make it generic:
Sub Matchup(ByRef arr1 As Variant, _
ByRef arr2 As Variant)
Dim i As Long
Dim j As Long
i = LBound(arr1)
j = LBound(arr2)
Do While i <= UBound(arr1) And j <= UBound(arr2)
If arr1(i) = arr2(j) Then
'found match, so do whatever needs doing
'---------------------------------------
i = i + 1
j = j + 1
Else
If arr2(j) < arr1(i) Then
j = j + 1
Else
If arr1(i) < arr2(j) Then
i = i + 1
End If
End If
End If
Loop
End Sub
This will catch matches at both ends of both arrays, which your original
code didn't do.
Nice bit of code and thanks again for the tip.
RBS
"Tom Ogilvy" wrote in message
...
By product of my method.
Will compare both
Don't waste your time. Simple logic tells the tail. Just use
Stephen's
method if you understand that.
--
Regards,
Tom Ogilvy
"RB Smissaert" wrote in message
...
Will compare both, but I do need to match.
I need to know the position of the element in array1 in array2.
RBS
"Tom Ogilvy" wrote in message
...
Think you will find a binary search slower than what I have
proposed.
Particularly since you are trying not to match.
--
Regards,
Tom Ogilvy
"RB Smissaert" wrote in message
...
I got a reply about this off-list from Peter T and I think his
suggestion
was spot on.
Use a binary search algorytyhm.
This is in the book of Stephen Bullen, Professional Excel
Development,
which
I have, so have
used that and it speeds things up indeed.
Thinking about it it was a bit silly to run the inner loop
sequentially
from
LBound to UBound
considering I knew both arrays were sorted.
Will try your code as well though.
RBS
"Tom Ogilvy" wrote in message
...
No it is completely different. I only use one Loop.
--
Regards,
Tom Ogilvy
"RB Smissaert" wrote in message
...
Thanks, will have a look at that as well. So this is a different
way
to
walk
the 2 arrays?
This is the sequence as it is now, where RC1 and RC2 are the
UBounds
of
the
arrays.
For r2 = 0 To RC2 - 1
For r1 = r1F To RC1
If arrNew1(r1) = arrNew2(r2) Then
For c = 1 To CC2
arr3(r1, SC + c - 1) = arr2(r2, c)
Next
r1F = r1 + 1
Exit For
End If
If arrNew1(r1) arrNew2(r2) Then
Exit For
End If
Next
'no point getting out early here
Next
This might actually be a similar idea as yours, although I
haven't
looked
at
it properly yet.
RBS
"Tom Ogilvy" wrote in message
...
didn't you say the arrays are sorted?
Both arrays are sorted ascending
No one seems to take notice of this critical fact.
Perhaps use something like this:
Sub ABC()
Dim v1() As Long, v2() As Long
' Dummy code to generate
' two sorted arrays
i = 1
j = 1
k = 1
For i = 1 To 100000
If Rnd() < 0.03 Then
ReDim Preserve v1(1 To j)
v1(j) = i
j = j + 1
End If
If Rnd() < 0.03 Then
ReDim Preserve v2(1 To k)
v2(k) = i
k = k + 1
End If
Next
' algorithm to check for match
i = LBound(v1)
j = LBound(v2)
Do While i < UBound(v1) And j < UBound(v2)
If v1(i) < v2(j) Then
i = i + 1
ElseIf v2(j) < v1(i) Then
j = j + 1
ElseIf v1(i) = v2(j) Then
MsgBox "Match found at: " & vbNewLine & _
"v1(" & i & ")=" & v1(i) & vbNewLine & _
"v2(" & j & ")=" & v2(j)
Exit Sub
End If
Loop
MsgBox "Both have unique entries"
End Sub
--
Regards,
Tom Ogilvy
"RB Smissaert" wrote in
message
...
Will have a look at that.
I am not interested in duplicates, but I need to know if
there
is
a
match
and if so
what the position is of the matching element in one of the
arrays.
Looking quickly at your code that should be possible.
RBS
"Jim Cone" wrote in message
...
RBS,
This demo code takes less than second to load and compare.
Jim Cone
San Francisco, USA
'--------------------------------
Sub AreTheyTheSame()
Dim colNumbers As VBA.Collection
Dim arrOne() As String
Dim arrTwo() As String
Dim lngNum As Long
Set colNumbers = New VBA.Collection
ReDim arrOne(1 To 5000)
ReDim arrTwo(1 To 10000)
'Load arrays
For lngNum = 1 To 5000
arrOne(lngNum) = lngNum
Next
For lngNum = 1 To 10000
arrTwo(lngNum) = lngNum + 5000
Next
'Create a duplicate value
arrTwo(10000) = 3000
'Load collection and check for duplicates
For lngNum = 1 To UBound(arrOne)
colNumbers.Add vbNullString, arrOne(lngNum)
Next
For lngNum = 1 To UBound(arrTwo)
On Error Resume Next
colNumbers.Add vbNullString, arrTwo(lngNum)
If Err.Number = 457 Then
MsgBox arrTwo(lngNum) & " is a duplicate. "
Exit For
End If
Next
Set colNumbers = Nothing
End Sub'------------------------------------
"RB Smissaert" wrote in
message
...
Thanks, will have a look at both suggestions.
Actually, I just found a way to speed this up, but that
couldn't
be
seen
from the way I put the question.
Both arrays are variant arrays and I found I needed to do
Val(array1element)
= Val(array2element).
This slows it up.
If I make 2 new arrays re-dimmed with the same size, but
now
declared
as
long and transfer the values to
compare to these new arrays and do the comparisons on that
it
speeds
it
up
a
lot.
I started this routine with match, but found that a double
loop
was
much
faster. Will try again though.
RBS
|