Ricerca binaria VBA

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Questo spunto l'ho preso sfogliando un mio vecchio libro che tratta di "trucchi" per VB6, il progenitore di VBA, scritto da Francesco Balena. La raccolta di trucchi è vasta e attuale, oltre che riproducibile in VBA a volte con piccoli adattamenti. 

In questo articolo parliamo di un semplice algoritmo di ricerca binaria.
[Leggi tutto al seguente link: https://www.excelvba.it/forumexcel/ricerca-binaria-vba/]

[albatros54Moderatore albatros54 Karma: 89 pts]

manca la dichiarazione della variabile "ricerca_binaria", non è  un problema....scenario:

nella colonna A di un foglio excel inserisco dei valori numerici,dall'1 al 10, quando vado ad inserire la funzione come arr seleziono il range dall'A1 alla A10

valore da cercare metto 5 e non inserisco Last_item....nella cella #valore, steppando vedo che non inizializza l'arr.

Domanda: dove sta l'errore?

 

 

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

albatros54 wrote:manca la dichiarazione della variabile "ricerca_binaria"

Ottima osservazione, era la prima versione, italianizzata, della procedura, che poi ho inglesizzato e quindi doveva leggersi "binary_search".

Ho già corretto l'articolo.

Dovrebbe funzionare tutto, prova per cortesia.

[albatros54Moderatore albatros54 Karma: 89 pts]

`last_item = UBound(arr)<< tipo non corrispondente

 

Lo scenario è  il precedente

[Marius44Moderatore Marius44 Karma: 58 pts]

Salve a tutti

Confermo quanto asserito da Gioacchino (ciao)

La macro sembra corretta. Ho visto anche, a questo indirizzo http://www.devx.com/vb2themax/Tip/18913 l'originale.

Copia/incolla sul foglio e fa ... lo stesso scherzetto.

 

Ciao,

Mario  

[Marius44Moderatore Marius44 Karma: 58 pts]

Salve

Mi sono permesso "cambiare leggermente la Function.

Sembra funzionare.

Function binary_search(search As Variant, arr As Variant) As Long
Dim index As Long, first As Long, last As Long
Dim middle As Long, inverse_order As Boolean

    'gestisce il paramtero opzionale
    'If IsMissing(last_item) Then last_item = UBound(arr)

    first = 1                 'LBound(arr)
    last = arr.Rows.Count     'UBound(arr)
    
    'deduce la direzione dell'ordinamento
    
    inverse_order = first > last      'inverse_order = (arr(first) > arr(last))
    binary_search = first - 1
    Do
        middle = (first + last) \ 2
        If arr(middle) = search Then
            binary_search = middle
            Exit Do
        ElseIf ((arr(middle) < search) Xor inverse_order) Then
            first = middle + 1
        Else
            last = middle - 1
        End If
    Loop Until first > last
    
End Function

Fatemi sapere. Ciao,

Mario

[albatros54Moderatore albatros54 Karma: 89 pts]

sembra funzionare, per hai eliminato la variabile optional 🙂 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao Gioacchino

L'ho eliminata per mia pura comodità. Non ho provato ma, credo, dovrebbe funzionare lo stesso.

 

Ciao,

Mario 

[albatros54Moderatore albatros54 Karma: 89 pts]

secondo me , non è tanto la variabile  che da problemi, ma il fatto che non riconosce il range che si seleziona come Array, e quindi non inizializza la arr

ciao

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Non ho testato le vostre osservazioni ma poichè il codice non è pensato per Excel, ma per VB6 (adattato a VBA), presumo che non possa accettare semplicemente un range ma che questo vada spalmato in un array (immagino si possa comunque inserire un controllo personalizzato del tipo "if isRange then array=transpose(range)"

[zer0kelvinPartecipante zer0kelvin Karma: 5 pts]

Ciao a tutti.

Per poter usare la function con un range (ma di una sola riga o colonna) si potrebbe usare questa variante

`'...
Dim middle As Long, inverse_order As Boolean
    'gestisce il paramtero opzionale
    If TypeName(arr) = "Range" Then
        With arr
            If .Columns.Count > 1 And .Rows.Count = 1 Then
                arr = Application.Transpose(Application.Transpose(arr.Rows(1)))
            ElseIf .Columns.Count = 1 And .Rows.Count > 1 Then
                arr = Application.Transpose(arr)
            Else
                Exit Function
            End If
        End With
    End If
    If IsMissing(last_item) Then last_item = UBound(arr)
'...`

Oppure si potrebbe usare un For Each Cella In arr.Cells su un array di appoggio, ma credo che si vada oltre lo scopo della function.

Poi, è possibile che per fare una ricerca in un range sia più efficiente Range.Find

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Sì, questa del Typename era quello che avevo in mente e che avevo già usato in altre occasioni. Del resto non volevo complicare troppo la funzioncina presa da un testo non Excel oriented come ha rilevato Mario 🙂 (io ho il libro ma non il link perchè nel frattempo il link originale sta puntando a qualcos'altro che non consiglio di raggiungere)

[patelModeratore patel Karma: 51 pts]

zer0kelvin wrote:Poi, è possibile che per fare una ricerca in un range sia più efficiente Range.Find

Lo penso anch'io, secondo me non ha senso applicare questo metodo di ricerca ad un range

[Autore]

Articoli