Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > comp.lang.basic.visual.misc > #843
| From | Schmidt <sss@online.de> |
|---|---|
| Newsgroups | comp.lang.basic.visual.misc |
| Subject | Re: What is a class? |
| Date | 2012-02-27 22:14 +0100 |
| Organization | Aioe.org NNTP Server |
| Message-ID | <jigroc$q1h$1@speranza.aioe.org> (permalink) |
| References | (9 earlier) <jicjab$6ta$1@dont-email.me> <6sD2r.204924$WX2.187127@newsfe28.ams2> <jig9cq$val$1@dont-email.me> <jiggst$rbl$1@speranza.aioe.org> <jigmdl$k11$1@dont-email.me> |
Am 27.02.2012 20:43, schrieb GS:
> Ok, Olaf:
> Your code does the job considerably faster (25% to 33%) but tested on
> the same lists it returns different results. Here's my criteria...
>
> Option1:
> Return a unique list of matches found (no dupes)
>
> Option2:
> Return a list of all matches found
>
> Option3:
> Return a unique list of non-matches (no dupes)
>
> Option4:
> Return a list of all non-matches
>
> I will run both functions in xl2003 so I can pass you a file that you
> can test drive yourself...
>
Better to test that with a small dataset, which is
able to show the differences already:
Here's my two lists (only 10 Rows in each XL-Column):
A and B (as FilterList and CheckList)
---------------------------------------
a 1
b 2
a 3
b 4
x 5
1 a
2 a
3 c
4 d
6 x
---------------------------------------
---------------------------------------
Option 1: Return a unique list of matches found (no dupes)
(the left result-column is yours, the right one mine respectively):
a a
x x
1 1
2 2
3
4
Our Reported Matchcount for Option1:
11 6
---------------------------------------
---------------------------------------
Option2: (Matches incl. Dupes) is identically
a
a
x
1
2
3
4
Also the reported MatchCount is the same: 7
---------------------------------------
---------------------------------------
Option3: Return a unique list of non-matches (no dupes)
Our listing is identically:
b
6
But your MatchCount seems incorrect
(I reported the NonMatch-Count - maybe I should report it as (10-2)?)
15 2
---------------------------------------
---------------------------------------
Option4: Return a list of all non-matches
Listings are identically again:
b
b
6
But the MatchCount seems screwed once more:
7 3
---------------------------------------
Maybe I've copied the wrong version of your code -
but it was the one, which you said, you already
placed a fix in.
Oh - and there's also a bug to fix in my routine <g>...
(although not affecting the results - it only ran
out of indexes due to a too optimistic ArrResult-Redim
in case of huge empty-cell-areas.
It's in the Redim Results(...) line, which needs to be changed to:
ReDim Results(1 To IIf(DupesAllowed, UBound(vCheckRng), DCheck.Count))
Just for completeness, I post the entire fixed routine again now
(followed by the version of your routine I've made my comparison with):
Option Explicit
Public Enum FilterMode
fltReturnMatches
fltReturnNonMatches
End Enum
Public Enum ExpectedTypes
UseStringComparison
UseIntegerComparisons
UseDoubleComparisons
End Enum
'Returns the Count of found Matches or NonMatches (dep. on the Mode-Enum)
Function FilterMatches2&(vFilterRng(), vCheckRng(), _
Optional OutColName As String, _
Optional ByVal Mode As FilterMode, _
Optional ByVal DupesAllowed As Boolean, _
Optional ByVal TypeComparison As ExpectedTypes)
Dim DCheck As cSortedDictionary, DDupes As cSortedDictionary
Dim i As Long, Key, Match As Boolean, Results(), ResCount As Long, Out()
Set DCheck = New cSortedDictionary
DCheck.StringCompareMode = TextCompare
Set DDupes = New cSortedDictionary
DDupes.StringCompareMode = TextCompare
For i = LBound(vCheckRng) To UBound(vCheckRng)
Select Case TypeComparison
Case UseStringComparison: Key = CStr(vCheckRng(i, 1))
Case UseIntegerComparisons: Key = CCur(vCheckRng(i, 1))
Case UseDoubleComparisons: Key = CDbl(vCheckRng(i, 1))
End Select
If Not DCheck.Exists(Key) Then DCheck.Add Key
Next i
If DCheck.Count = 0 Then Exit Function
ReDim Results(1To IIf(DupesAllowed,UBound(vCheckRng),DCheck.Count))
For i = LBound(vFilterRng) To UBound(vFilterRng)
Select Case TypeComparison
Case UseStringComparison: Key = CStr(vFilterRng(i, 1))
Case UseIntegerComparisons: Key = CCur(vFilterRng(i, 1))
Case UseDoubleComparisons: Key = CDbl(vFilterRng(i, 1))
End Select
Match = DCheck.Exists(Key)
If Match And Mode = fltReturnMatches Then
If Not DupesAllowed Then DCheck.Remove Key
ResCount = ResCount + 1: Results(ResCount) = vFilterRng(i, 1)
ElseIf Not Match And Mode = fltReturnNonMatches Then
If DupesAllowed Then
ResCount = ResCount + 1:Results(ResCount) = vFilterRng(i, 1)
ElseIf Not DDupes.Exists(Key) Then
DDupes.Add Key
ResCount = ResCount + 1:Results(ResCount) = vFilterRng(i, 1)
End If
End If
Next i
If ResCount = 0 Or Len(OutColName) = 0 Then Exit Function
ReDim Out(1 To ResCount, 1 To 1)
For i = 1 To ResCount: Out(i, 1) = Results(i): Next i 'copy over
'**only the following block needs to be commed out to test in VB6**
Columns(OutColName).ClearContents
With Range(OutColName & "1").Resize(ResCount, 1)
.Value = Out
.NumberFormat = "0000000000000" '..optional
.EntireColumn.AutoFit '..optional
End With
'************ End of the Excel/VBA-related code-block *************
FilterMatches2 = ResCount
End Function
Function FilterMatches(Matches As Long,Criteria() As Variant) As Boolean
' Compares 2 user-specified cols and filters matches found.
' User can also specific target col to receive resulting list.
' Optionally supports returning a unique list or allow duplicates.
' Optionally supports returning matches or non-matches.
'
' Args In: Matches: ByRef var to return number of matches found
'to the caller.
'
' vCriteria(): A variant array containing the filtering
' parameters.
' Criteria(0) - Address of the values to be filtered
' Criteria(1) - Address of the values to check
' Criteria(2) - Label of the column to put the filtered
' list
' Criteria(3) - Numeric value to determine if we return
' matches or non-matches
' Criteria(4) - Numeric value to determine if we return
' a unique list or allow dupes
'
' Returns: True if matches found and no error occurs;
' False if a: matches not found --OR-- error occurs;
Dim i&, j& 'as long
Dim vFilterRng, vCheckRng, vResult, vaMatches(), vaNoMatches()
Dim vaDataOut() 'as variant
Dim bReturnMatches As Boolean, bMatch As Boolean
Dim bDupesAllowed As Boolean
Dim sMsg$, sRngOut$ 'as string
'Load the filtering criteria
vFilterRng = Range(Criteria(0)):
vCheckRng = Range(Criteria(1)): sRngOut = Criteria(2)
bReturnMatches = (Criteria(3) = 1): bDupesAllowed = (Criteria(4) = 1)
ReDim vaMatches(UBound(vFilterRng)):
ReDim vaNoMatches(UBound(vFilterRng)):j = 0
'Load the Collection with the values to be checked.
'Collections only allow unique keys so use OERN (no need to check
'if they already exist)
Dim cItemsToCheck As New Collection: On Error Resume Next
For i = LBound(vCheckRng) To UBound(vCheckRng)
cItemsToCheck.Add Key:=CStr(vCheckRng(i, 1)), Item:=vbNullString
Next 'i
Err.Clear
'Check the Collection for matches
On Error GoTo MatchFound
For i = LBound(vFilterRng) To UBound(vFilterRng)
bMatch = False '..reset
cItemsToCheck.Add Key:=CStr(vFilterRng(i, 1)), Item:=vbNullString
If bMatch Then
If bReturnMatches Then vaMatches(j) = vFilterRng(i, 1): j = j + 1
Else
vaNoMatches(j) = vFilterRng(i, 1): j = j + 1
cItemsToCheck.Remove CStr(vFilterRng(i,1)) '..so dupes of it
'don't get counted
End If 'bMatch
Next 'i
'Initialize the return list
If bReturnMatches Then vResult = vaMatches Else vResult = vaNoMatches
'Return a list of unique values?
If Not bDupesAllowed Then
On Error GoTo UniqueList
Dim cUniqueList As New Collection
For i = LBound(vResult) To UBound(vResult)
cUniqueList.Add Key:=CStr(vResult(i)), Item:=vbNullString
Next 'i
ReDim vaDataOut(cUniqueList.Count - 1, 0): j = 0
Else
ReDim vaDataOut(UBound(vResult), 0): j = 0
End If 'Not bDupesAllowed
Err.Clear: On Error GoTo ErrExit
'Make the list to return contiguous.
For i = LBound(vaDataOut) To UBound(vaDataOut)
If Not vResult(i) = Empty Then vaDataOut(j, 0) = vResult(i):j = j + 1
Next 'i
If Matches > 0 Then '..only write if Matches > 0
Columns(sRngOut).ClearContents
With Range(sRngOut & "1").Resize(UBound(vaDataOut) + 1, 1)
.Value = vaDataOut
.NumberFormat = "0000000000000" '..optional
.EntireColumn.AutoFit '..optional
End With
End If 'Matches > 0
ErrExit:
' If bReturnMatches Then Matches = UBound(vResult) ' + 1
FilterMatches = (Err = 0): Exit Function
MatchFound:
bMatch = True: Matches = Matches + 1: Resume Next
UniqueList:
vResult(i) = Empty: Matches = Matches + 1: Resume Next
End Function 'FilterMatches()
Olaf
Back to comp.lang.basic.visual.misc | Previous | Next — Previous in thread | Next in thread | Find similar
What is a class? Peter Nolan <peter.nolan40@gmail.com> - 2012-02-24 04:02 -0800
Re: What is a class? "Auric__" <not.my.real@email.address> - 2012-02-24 14:06 +0000
Re: What is a class? Peter Nolan <peter.nolan40@gmail.com> - 2012-02-25 03:07 -0800
Re: What is a class? Helmut_Meukel <Helmut_Meukel@bn-hof.invalid> - 2012-02-25 14:19 +0100
Re: What is a class? "Auric__" <not.my.real@email.address> - 2012-02-25 21:26 +0000
Re: What is a class? Jim Mack <no-uce-ube@mdxi.com> - 2012-02-25 18:58 -0500
Re: What is a class? GS <gs@somewhere.net> - 2012-02-25 19:39 -0500
Re: What is a class? "Auric__" <not.my.real@email.address> - 2012-02-26 03:09 +0000
Re: What is a class? Jim Mack <no-uce-ube@mdxi.com> - 2012-02-25 22:35 -0500
Re: What is a class? GS <gs@somewhere.net> - 2012-02-25 22:55 -0500
Re: What is a class? "Farnsworth" <nospam@nospam.com> - 2012-02-25 23:27 -0500
Re: What is a class? GS <gs@somewhere.net> - 2012-02-26 01:30 -0500
Re: What is a class? "Auric__" <not.my.real@email.address> - 2012-02-26 04:41 +0000
Re: What is a class? ralph <nt_consulting64@yahoo.net> - 2012-02-25 23:05 -0600
Re: What is a class? "Henning" <computer_hero@coldmail.com> - 2012-02-26 11:24 +0100
Re: What is a class? ralph <nt_consulting64@yahoo.net> - 2012-02-25 23:03 -0600
Re: What is a class? GS <gs@somewhere.net> - 2012-02-26 01:26 -0500
Re: What is a class? "Stuart McCall" <smccall@myunrealbox.com> - 2012-02-27 04:15 +0000
Re: What is a class? ralph <nt_consulting64@yahoo.net> - 2012-02-27 00:48 -0600
Re: What is a class? "Mayayana" <mayayana@invalid.nospam> - 2012-02-27 08:57 -0500
Re: What is a class? "Stuart McCall" <smccall@myunrealbox.com> - 2012-02-27 19:19 +0000
Re: What is a class? "Stuart McCall" <smccall@myunrealbox.com> - 2012-02-27 19:12 +0000
Re: What is a class? "Bob Butler" <bob_butler@cox.invalid> - 2012-02-27 06:06 -0800
Re: What is a class? "Stuart McCall" <smccall@myunrealbox.com> - 2012-02-27 19:24 +0000
Re: What is a class? GS <gs@somewhere.net> - 2012-02-27 11:01 -0500
Re: What is a class? ralph <nt_consulting64@yahoo.net> - 2012-02-27 11:07 -0600
Re: What is a class? GS <gs@somewhere.net> - 2012-02-27 13:10 -0500
Re: What is a class? Schmidt <sss@online.de> - 2012-02-27 19:09 +0100
Re: What is a class? GS <gs@somewhere.net> - 2012-02-27 13:29 -0500
Re: What is a class? GS <gs@somewhere.net> - 2012-02-27 14:43 -0500
Re: What is a class? Schmidt <sss@online.de> - 2012-02-27 22:14 +0100
Re: What is a class? GS <gs@somewhere.net> - 2012-02-27 16:45 -0500
Re: What is a class? GS <gs@somewhere.net> - 2012-02-27 18:23 -0500
Re: What is a class? GS <gs@somewhere.net> - 2012-02-27 23:26 -0500
Re: What is a class? Schmidt <sss@online.de> - 2012-02-28 13:54 +0100
Re: What is a class? GS <gs@somewhere.net> - 2012-02-28 08:37 -0500
Re: What is a class? ralph <nt_consulting64@yahoo.net> - 2012-02-28 09:19 -0600
Re: What is a class? GS <gs@somewhere.net> - 2012-02-28 10:42 -0500
Re: What is a class? Schmidt <sss@online.de> - 2012-02-29 06:47 +0100
Re: What is a class? GS <gs@somewhere.net> - 2012-02-29 09:39 -0500
Re: What is a class? GS <gs@somewhere.net> - 2012-02-29 13:33 -0500
Re: What is a class? GS <gs@somewhere.net> - 2012-02-29 14:43 -0500
Re: What is a class? Schmidt <sss@online.de> - 2012-02-29 21:39 +0100
Re: What is a class? GS <gs@somewhere.net> - 2012-02-29 16:15 -0500
Re: What is a class? Schmidt <sss@online.de> - 2012-02-29 23:20 +0100
Re: What is a class? GS <gs@somewhere.net> - 2012-02-28 00:16 -0500
Re: What is a class? Jim Mack <no-uce-ube@mdxi.com> - 2012-02-27 13:26 -0500
Re: What is a class? "Stuart McCall" <smccall@myunrealbox.com> - 2012-02-27 19:33 +0000
Re: What is a class? Jim Mack <no-uce-ube@mdxi.com> - 2012-02-27 15:50 -0500
Re: What is a class? Helmut_Meukel <Helmut_Meukel@bn-hof.invalid> - 2012-02-26 11:02 +0100
Re: What is a class? GS <gs@somewhere.net> - 2012-02-26 14:23 -0500
Re: What is a class? GS <gs@somewhere.net> - 2012-02-26 17:09 -0500
Re: What is a class? ralph <nt_consulting64@yahoo.net> - 2012-02-25 22:21 -0600
Re: What is a class? "Auric__" <not.my.real@email.address> - 2012-02-26 04:51 +0000
Re: What is a class? ralph <nt_consulting64@yahoo.net> - 2012-02-25 23:10 -0600
Re: What is a class? Peter Nolan <peter.nolan40@gmail.com> - 2012-02-26 04:11 -0800
Re: What is a class? Helmut_Meukel <Helmut_Meukel@bn-hof.invalid> - 2012-02-26 16:37 +0100
Re: What is a class? "Auric__" <not.my.real@email.address> - 2012-02-26 18:36 +0000
Re: What is a class? ralph <nt_consulting64@yahoo.net> - 2012-02-26 14:11 -0600
Re: What is a class? Peter Nolan <peter.nolan40@gmail.com> - 2012-02-27 03:11 -0800
Re: What is a class? "Auric__" <not.my.real@email.address> - 2012-02-27 16:33 +0000
Re: What is a class? Jim Mack <no-uce-ube@mdxi.com> - 2012-02-27 13:33 -0500
Re: What is a class? Peter Nolan <peter.nolan40@gmail.com> - 2012-02-28 04:07 -0800
Re: What is a class? Peter Nolan <peter.nolan40@gmail.com> - 2012-02-25 03:33 -0800
Re: What is a class? Peter Nolan <peter.nolan40@gmail.com> - 2012-02-25 04:19 -0800
Re: What is a class? "Ivar" <ivar.ekstromer000@ntlworld.com> - 2012-02-24 15:15 +0000
Re: What is a class? GS <gs@somewhere.net> - 2012-02-24 14:52 -0500
Re: What is a class? "Ivar" <ivar.ekstromer000@ntlworld.com> - 2012-02-24 23:10 +0000
Re: What is a class? GS <gs@somewhere.net> - 2012-02-24 19:46 -0500
Re: What is a class Way off Topic "Ivar" <ivar.ekstromer000@ntlworld.com> - 2012-02-25 02:20 +0000
Re: What is a class Way off Topic GS <gs@somewhere.net> - 2012-02-25 16:57 -0500
Re: What is a class? Helmut_Meukel <Helmut_Meukel@bn-hof.invalid> - 2012-02-25 11:36 +0100
Re: What is a class? Peter Nolan <peter.nolan40@gmail.com> - 2012-02-25 03:35 -0800
Re: What is a class? Jim Mack <no-uce-ube@mdxi.com> - 2012-02-24 15:23 -0500
Re: What is a class? "Auric__" <not.my.real@email.address> - 2012-02-25 01:33 +0000
Re: What is a class? Peter Nolan <peter.nolan40@gmail.com> - 2012-02-25 03:09 -0800
Re: What is a class? "Mayayana" <mayayana@invalid.nospam> - 2012-02-24 20:05 -0500
csiph-web