jhon's quote was super!!
auddhav
On Fri, Oct 7, 2011 at 6:26 PM, Paul Schreiner <schreiner_paul@att.net>wrote:
> **
>
>
> I think I've found a couple of problems.
>
> #1 may be a "case" issue.
> I've found a couple of cases where lowercase is used in one list, but
> uppercase
> is used in another:
> (p01-070161-01411-A100)
>
> #2.. You're using an Interval Halving technique for searching the list.
> However, for it to work properly, the data has to be sorted correctly.
>
> Unfortunately, it doesn't look like it's sorting properly.
> Specifically,
> the ASCII code for "-" is 45
> the ASCII code for "0" is 48
> (1-9 are codes 49-57)
>
> But in the sort, "-" is sorted AFTER numbers.
> (see rows:
> 6115: 020-SUB-0011
> 6116: 02-16917-3600
>
> 12513: 400-TUNECVR-0003
> 12514: 40-26314
> )
>
> for that reason, when the interval happens to test lines comparing 020 to
> 02-,
> it assumes that the 020 should be AFTER 02-, but the next iteration finds
> that
> it is outside the range,
> and therefore assumes it cannot find it.
> I'm not sure what can be done about this sorting problem, however, I have
> an
> alternate solution.
>
> I prefer to use a Dictionary object instead of arrays.
>
> try this macro:
>
> Sub CompareUsingDict()
> Dim x As Long
> Dim sdlast As Long
> Dim pilast As Long
> Dim y As Object
> Dim Dict_SD, Dict_PH
> Dim tstart, tstop, TElapsed, TMin, TSec, msg
> tstart = Timer
> '-----------------------------------------------------
> Set Dict_SD = CreateObject("Scripting.Dictionary")
> Dict_SD.RemoveAll
> Set Dict_PH = CreateObject("Scripting.Dictionary")
> Dict_PH.RemoveAll
> '-----------------------------------------------------
>
> Application.EnableEvents = False
> Application.ScreenUpdating = False
> Application.Calculation = xlCalculationManual
> Sheet1.Activate
>
> 'Get the size of the other two databases
> sdlast = Sheet2.Cells.Find(What:="*", After:=[A1],
> SearchOrder:=xlByRows,
> SearchDirection:=xlPrevious).Row
> pilast = Sheet3.Cells.Find(What:="*", After:=[A1],
> SearchOrder:=xlByRows,
> SearchDirection:=xlPrevious).Row
> For x = 3 To sdlast
> If (Not Dict_SD.exists(UCase(Sheet2.Cells(x, 1).Value))) Then
> Dict_SD.Add UCase(Sheet2.Cells(x, 1).Value), x
> End If
> Next x
> For x = 3 To pilast
> If (Not Dict_PH.exists(UCase(Sheet3.Cells(x, 1).Value))) Then
> Dict_PH.Add UCase(Sheet3.Cells(x, 1).Value), x
> End If
> Next x
> x = 3
>
> Do While Not Cells(x, 1) = ""
> If (Dict_SD.exists(UCase(Sheet1.Cells(x, 1).Value))) Then
> Sheet1.Cells(x, 4).Value = Dict_SD.Item(UCase(Sheet1.Cells(x, 1).Value))
> '"Y"
> If (Dict_PH.exists(ucase(Sheet1.Cells(x, 1).Value))) Then
> Sheet1.Cells(x, 5).Value = Dict_PH.Item(ucase(Sheet1.Cells(x, 1).Value))
> '"Y"
> x = x + 1
> Loop
> Application.EnableEvents = True
> Application.ScreenUpdating = True
> Application.Calculation = xlCalculationAutomatic
>
>
> 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
>
> msg = "Using Dictionary"
> tstop = Timer
> TMin = 0
> TElapsed = tstop - tstart
> TMin = TElapsed \ 60
> TSec = TElapsed Mod 60
> msg = msg & Chr(13) & Chr(13)
> If (TMin > 0) Then msg = msg & TMin & " mins "
> msg = msg & TSec & " sec"
> MsgBox msg
>
>
> 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
>
> End Sub
>
>
> hope this helps.
> Paul
> -----------------------------------------
> "Do all the good you can,
> By all the means you can,
> In all the ways you can,
> In all the places you can,
> At all the times you can,
> To all the people you can,
> As long as ever you can." - John Wesley
> -----------------------------------------
>
> ________________________________
> From: Scott <scott@mountainhighbnb.com>
> To: ExcelVBA@yahoogroups.com
> Sent: Thu, October 6, 2011 4:08:52 PM
> Subject: [ExcelVBA] Binary Search Problem
>
>
>
> I'm having a problem with a binary search of three databases. I'm trying to
>
> compare 86,000+ strings in one database against two other databases, each
> with
> over 86,000 entries as well. When I load the other two into arrays, then
> perform
> a binary search of the two arrays, I get 274 "hits" as being missing as
> compared
> to the master. But if I search the the same two databases using a FIND
> function
> (which takes an hour to run) I only get 85 hits. The two arrays are sorted,
>
> which I've double checked with a simple =if(a2<a3.... formula. I just can't
>
> figure it out. My binary search is below
> ------------------- CODE ----------------------
> Function BinarySearch(strArray() As String, strSearch As String) As Long
> Dim lngIndex As Long
> Dim lngFirst As Long
> Dim lngLast As Long
> Dim lngMiddle As Long
> Dim bolInverseOrder As Boolean
> lngFirst = LBound(strArray)
> lngLast = UBound(strArray)
> bolInverseOrder = (strArray(lngFirst) > strArray(lngLast))
> BinarySearch = lngFirst - 1
> Do
> lngMiddle = (lngFirst + lngLast) \ 2
> If strArray(lngMiddle) = strSearch Then
> BinarySearch = lngMiddle
> Exit Do
> ElseIf ((strArray(lngMiddle) < strSearch) Xor bolInverseOrder) Then
> lngFirst = lngMiddle + 1
> Else
> lngLast = lngMiddle - 1
> End If
> Loop Until lngFirst > lngLast
> End Function
> ------------------- CODE ----------------------
>
> I'll email the file to the moderator so they can post it in the files
> section.
> Thanks for your help.
>
> Scott B)
>
> moderator edit:
> The file, called BinarySearchProblem.xlsm has been added to the
> Files\Files needing help
> section.
>
> [Non-text portions of this message have been removed]
>
>
>
[Non-text portions of this message have been removed]
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------
Tidak ada komentar:
Posting Komentar