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. Se un vettore è già ordinato, è possibile effettuare molto rapidamente una ricerca tra i suoi elementi utilizzando l’algoritmo di ricerca binaria (binary search), più efficiente della ricerca lineare o sequenziale, che consiste in un semplice ciclo che confronta il valore cercato con tutti gli elementi del vettore. La routine funziona con vettori di tipo numerico o stringa, ordinati sia in senso ascendente che discendente. Il confronto tra stringhe avviene in modo case-sensitive (ma la modifica è banale). L’argomento opzionale last_item è l’indice dell’ultimo elemento che deve essere ordinato, ed è utile se il vettore è riempito solo parzialmente.

Option Explicit

Function binary_search(arr As Variant, search As Variant, Optional last_item 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 = LBound(arr)
    last = last_item
    
    'deduce la direzione dell'ordinamento
    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

Si possono migliorare le prestazioni della routine se si conosce il tipo degli elementi del vettore ordinato. Basta modificare la prima riga del codice. Ad esempio, la modifica che sgeue agisce solo con vettori di Long:

Function binary_search(arr As Long, search As Variant, Optional last_item As Variant) As Long

 

Ricerca binaria VBA

Ricerca binaria VBA

Login Registrati
Stai vedendo 13 articoli - dal 1 a 13 (di 13 totali)
  • Autore
    Articoli
  • #7008 Risposta

    vecchio frac
    Moderatore
      14 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/]

      #7010 Risposta
      albatros54
      albatros54
      Moderatore
        7 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?

         

         

        #7013 Risposta

        vecchio frac
        Moderatore
          14 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.

          #7017 Risposta
          albatros54
          albatros54
          Moderatore
            7 pts

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

             

            Lo scenario è  il precedente

            #7018 Risposta
            Marius44
            Marius44
            Moderatore
              4 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  

              #7023 Risposta
              Marius44
              Marius44
              Moderatore
                4 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

                #7025 Risposta
                albatros54
                albatros54
                Moderatore
                  7 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 )
                  #7026 Risposta
                  Marius44
                  Marius44
                  Moderatore
                    4 pts

                    Ciao Gioacchino

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

                     

                    Ciao,

                    Mario 

                    #7027 Risposta
                    albatros54
                    albatros54
                    Moderatore
                      7 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 )
                      #7031 Risposta

                      vecchio frac
                      Moderatore
                        14 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)"

                        #7035 Risposta
                        zer0kelvin
                        zer0kelvin
                        Partecipante

                          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

                          #7044 Risposta

                          vecchio frac
                          Moderatore
                            14 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)

                            #7046 Risposta
                            patel
                            patel
                            Moderatore
                              5 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

                            Login Registrati
                            Stai vedendo 13 articoli - dal 1 a 13 (di 13 totali)
                            Rispondi a: Ricerca binaria VBA
                            Gli allegati sono permessi solo ad utenti REGISTRATI
                            Le tue informazioni:



                            albatros54
                            albatros54 - 453 risposte

                            vecchio frac - 412 risposte

                            Marius44
                            Marius44 - 257 risposte

                            patel
                            patel - 257 risposte

                            Luca73
                            Luca73 - 185 risposte