Risultati da 1 a 7 di 7

Discussione: [Tutorial VBA] Funzione FILTER



  1. #1
    L'avatar di Marius44
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Catania
    Età
    73
    Messaggi
    3207
    Versione Office
    Excel2010
    Likes ricevuti
    625
    Likes dati
    155

    [Tutorial VBA] Funzione FILTER

    Salve a tutti

    Quando ci capita di dover cercare o estrapolare una sottostringa da una stringa ci affanniamo costruendo fior di formule combinando insieme più funzioni. Dimentichiamo (per quanto mi riguarda, troppo spesso) la funzione di cui al titolo.

    La funzione FILTER è una delle funzioni più versatili e veloci nelle ricerche. Analizza in maniera rapida un array cercando una sottostringa e restituisce un altro array contenente solo gli elementi che includono (o non includono) la sottostringa cercata.
    Ecco la definizione
    Restituisce una matrice con base zero contenente un sottoinsieme di una matrice di stringhe definito in base a un criterio di filtro specificato.

    La sintassi della funzione è la seguente:
    Arr() = FILTER(Source(), Search, [Include],[Compare])

    Source (obbligatorio) deve essere un array monodimensionale. Search (obbligatorio) può essere qualunque cosa, da una singola lettera ad un gruppo di lettere, maiuscole o minuscole o miste.
    Se l’argomento Include (facoltativo) è True o viene omesso, l’array risultante contiene tutti gli elementi in Source contenenti la sottostringa Search; se è False l’array risultante contiene solo gli elementi che non la contengono. CompareMethod (facoltativo) specifica una ricerca sensibile a maiuscole/minuscole.

    Nell’esempio che allego ho preso in prestito da un amico un elenco di circa 9000 sostantivi (colonna A)
    Ecco il codice:
    Codice: 
    Option Explicit
    Sub Filtra()
    Dim nomi() As String, trova() As String, stringa As String, iTempo, fTempo
    Dim escl As String, mas As String, uRiga As Long, i As Long
        iTempo = Timer
        uRiga = Cells(Rows.Count, 1).End(xlUp).Row
        stringa = Cells(2, 4).Text
        escl = Cells(6, 4): mas = Cells(7, 4)
        Range("G2,F:F").ClearContents
        If stringa = "" Then Exit Sub
        ReDim nomi(1 To uRiga)
        For i = 1 To uRiga
            nomi(i) = Cells(i, 1).Text
        Next i
        If escl <> "" And mas <> "" Then
            trova() = Filter(nomi, stringa, False, vbTextCompare)
        ElseIf escl = "" And mas <> "" Then
            trova() = Filter(nomi, stringa, , vbTextCompare)
        ElseIf escl <> "" And mas = "" Then
            trova() = Filter(nomi, stringa, False)
        ElseIf escl = "" And mas = "" Then
            trova() = Filter(nomi, stringa)
        End If
        For i = 0 To UBound(trova)
            Cells(i + 2, 6) = trova(i)
        Next i
        fTempo = Timer
        Range("G2") = Int(fTempo - iTempo) & " sec"
    End Sub
    Allego il file di prova.

    Ciao a tutti,
    Mario
    File Allegati File Allegati

  2. I seguenti 5 utenti hanno dato un "Like" a Marius44 per questo post:


  3. #2

    L'avatar di scossa
    Clicca e Apri
    Data Registrazione
    Jul 2015
    Località
    Verona Provincia
    Età
    57
    Messaggi
    1011
    Versione Office
    .
    Likes ricevuti
    365
    Likes dati
    0

    Re: [Tutorial VBA] Funzione FILTER

    Ciao Mario,

    grazie per aver rispolverato questa funzione di VBA; era finita, insieme a chissà quante altre, nel dimenticatoio (spazio della mia testa sempre più popolato, brutto segno di età che avanza) :-(

    Ho provato il tuo codice e, come temevo, devo dire che è piuttosto inefficiente: i tempi crescono in modo drammatico in rapporto alle righe esaminate (pur applicando al codice le solite "astuzie"), come evidente nell'ultima delle tabelle sotto riportate.
    Ho quindi provato in approccio diverso, copiando in blocco i nomi nella matrice, anziché ciclando ogni cella.

    Questa soluzione (filtra_scossa) è estremamente efficiente, come puoi vedere dai risultati riepilogati sotto.
    Ha solo il limite della funzione Transpose() che lavora con al massimo 65.536 elementi.
    Ovviamente il problema è facilmente risolvibile operando su singoli blocchi di 65.536 elementi (vedi filtra_scossa2), senza nessun decadimento delle prestazioni.
    righe target:
    10.000
    stringa cercata:
    ill
    trovati:
    174
    media:
    1,963281
    0,046875
    0,046875
    sub:
    marius
    scossa
    scossa2
    1,966796875
    0,044921875
    0,046875
    1,998046875
    0,046875
    0,048828125
    1,904296875
    0,048828125
    0,046875
    2,01171875
    0,046875
    0,044921875
    1,935546875
    0,046875
    0,046875
    righe target:
    20.000
    stringa cercata:
    ill
    trovati:
    384
    media:
    5,346875
    0,064844
    0,071094
    sub:
    marius
    scossa
    scossa2
    5,2421875
    0,0625
    0,06640625
    5,23828125
    0,0625
    0,078125
    5,2578125
    0,078125
    0,06640625
    5,64453125
    0,05859375
    0,078125
    5,3515625
    0,0625
    0,06640625
    righe target:
    30.000
    stringa cercata:
    ill
    trovati:
    522
    media:
    11,579688
    0,090625
    0,091406
    sub:
    marius
    scossa
    scossa2
    11,609375
    0,09375
    0,09765625
    11,49609375
    0,09375
    0,09375
    11,65625
    0,09375
    0,078125
    11,55859375
    0,078125
    0,09375
    11,578125
    0,09375
    0,09375
    righe target:
    70.000
    stringa cercata:
    ill
    trovati:
    1218
    media:
    70,427083
    0,215625
    sub:
    marius
    scossa
    scossa2
    69,67578125
    0,234375
    70,1328125
    0,203125
    71,47265625
    0,203125
    0,21875
    0,21875
    righe
    marius
    scossa
    scossa2
    10.000
    1,96328125
    0,046875
    0,046875
    20.000
    5,346875
    0,06484375
    0,07109375
    30.000
    11,5796875
    0,090625
    0,09140625
    70.000
    70,42708333
    0,215625

    Questi i codici delle tre sub:
    Codice: 
    Sub Filtra_marius()
    Dim nomi() As String, trova() As String, stringa As String, iTempo As Single, fTempo As Single
    Dim escl As String, mas As String, uRiga As Long, i As Long
      
        With Application
          .ScreenUpdating = False
          .Calculation = xlCalculationManual
        End With
        
        iTempo = Timer
        uRiga = Cells(Rows.Count, 1).End(xlUp).Row
        stringa = Cells(2, 4).Text
        escl = Cells(6, 4)
        mas = Cells(7, 4)
        Range("G2,F:F").ClearContents
        If stringa = "" Then Exit Sub
        ReDim nomi(1 To uRiga)
        For i = 1 To uRiga
            nomi(i) = Cells(i, 1).Text
        Next i
        If escl  "" And mas  "" Then
            trova() = Filter(nomi, stringa, False, vbTextCompare)
        ElseIf escl = "" And mas  "" Then
            trova() = Filter(nomi, stringa, , vbTextCompare)
        ElseIf escl  "" And mas = "" Then
            trova() = Filter(nomi, stringa, False)
        ElseIf escl = "" And mas = "" Then
            trova() = Filter(nomi, stringa)
        End If
        For i = 0 To UBound(trova)
            Cells(i + 2, 6) = trova(i)
        Next i
        fTempo = Timer
        Range("G2") = fTempo - iTempo
        With Application
          .ScreenUpdating = True
          .Calculation = xlCalculationAutomatic
        End With
        
    End Sub
    Codice: 
    Sub Filtra_scossa()
      Dim aTrovati As Variant
      Dim aTarget As Variant
      Dim nLR As Long
      Dim nStart As Single, nStop As Single
      Dim stringa As String, bIncluded As Boolean, nMaiusc As VbCompareMethod
      
      On Error GoTo safety_exit_
      nStart = Timer
      With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
      End With
      nLR = Cells(Rows.Count, 1).End(xlUp).Row
      Range("G2,F2:F" & nLR).ClearContents
      stringa = Cells(2, 4).Text
      
      If stringa = "" Then Err.Raise vbObjectError + 513, Description:="stringa di ricerca non specificata"
      
      bIncluded = IIf(Cells(6, 4).Value = "", True, False)
      nMaiusc = IIf(Cells(7, 4).Value = "", vbTextCompare, vbBinaryCompare)
      With Application
          aTarget = .Transpose(Range("A1:A" & nLR).Value)
          aTrovati = VBA.Filter(aTarget, stringa, bIncluded, nMaiusc)
          Range("F2:F" & UBound(aTrovati) + 2) = .Transpose(aTrovati)
      End With
      
    safety_exit_:
    
      nStop = Timer
      Range("G2") = nStop - nStart
      With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
      End With
      If Err.Number  0 Then MsgBox Err.Description
    End Sub
    Codice: 
    Sub Filtra_scossa2()
      Dim aTrovati As Variant
      Dim aTarget As Variant
      Dim nStart As Single, nStop As Single
      Dim stringa As String, bIncluded As Boolean, nMaiusc As VbCompareMethod
      Dim nLR As Long, i As Long, j As Long, nSubRows As Long
      Dim nFRA As Long, nFRB As Long, nLRA As Long, nLRB As Long
      Dim rSubRng As Range
      Const nMaxTranspose As Long = 65536
      
      On Error GoTo safety_exit_
      nStart = Timer
      With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
      End With
      nLR = Cells(Rows.Count, 1).End(xlUp).Row
      Range("G2,F2:F" & nLR).ClearContents
      stringa = Cells(2, 4).Text
      
      If stringa = "" Then Err.Raise vbObjectError + 513, Description:="stringa di ricerca non specificata"
      
      bIncluded = IIf(Cells(6, 4).Value = "", True, False)
      nMaiusc = IIf(Cells(7, 4).Value = "", vbTextCompare, vbBinaryCompare)
      nLRA = Range("A1:A" & nLR).Rows.Count
      j = Int(nLR / nMaxTranspose)
      nFRA = 1
      nFRB = 2
      nLRB = 2
      With Application
        For i = 0 To j
          nSubRows = .Min(nLRA, nMaxTranspose)
          Set rSubRng = Range("A" & nFRA & ":A" & nFRA + nSubRows - 1)
          aTarget = .Transpose(rSubRng.Value)
          aTrovati = VBA.Filter(aTarget, stringa, bIncluded, nMaiusc)
          nLRB = nFRB + UBound(aTrovati)
          Range("F" & nFRB & ":F" & nLRB) = .Transpose(aTrovati)
          nFRB = nLRB + 1
          nFRA = nFRA + nSubRows
          nLRA = nLRA - rSubRng.Rows.Count
        Next i
      End With
      
    safety_exit_:
      Set rSubRng = Nothing
      nStop = Timer
      Range("G2") = nStop - nStart
      With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
      End With
      If Err.Number  0 Then MsgBox Err.Description
    End Sub
    Bye!
    scossa
    scossa's web site
    ___
    Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

  4. I seguenti 2 utenti hanno dato un "Like" a scossa per questo post:


  5. #3
    L'avatar di Marius44
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Catania
    Età
    73
    Messaggi
    3207
    Versione Office
    Excel2010
    Likes ricevuti
    625
    Likes dati
    155

    Re: [Tutorial VBA] Funzione FILTER

    Grazie per l'intervento, scossa.
    Come hai giustamente detto, ho solo
    rispolverato questa funzione di VBA
    . Mi piaceva portare a conoscenza di tutti una funzione poco utilizzata.

    Ovvio che da un "guru" ci si aspetta quello che hai dimostrato e ti ringrazio ancora per l'intervento e per le precisazioni.

    Vedrò di "scovare" qualcosa d'altro per "stimolare" i tuoi preziosi interventi.

    Ciao,
    Mario

    PS vorrei chiederti un'ulteriore precisazione. In entrambe le macro alla fine c'è questa riga che mi viene segnata in rosso (tieni presente che io ho excel2007).
    Codice: 
    If Err.Number  0 Then MsgBox Err.Description
    E' andato tutto a posto come segue:
    Codice: 
    If Err.Number = 0 Then MsgBox Err.Description
    E' bastato aggiungere quell'uguale.
    E' un refuso oppure c'è sotto dell'altro?

  6. #4

    L'avatar di scossa
    Clicca e Apri
    Data Registrazione
    Jul 2015
    Località
    Verona Provincia
    Età
    57
    Messaggi
    1011
    Versione Office
    .
    Likes ricevuti
    365
    Likes dati
    0

    Re: [Tutorial VBA] Funzione FILTER

    Citazione Originariamente Scritto da Marius44 Visualizza Messaggio
    E' bastato aggiungere quell'uguale.
    E' un refuso oppure c'è sotto dell'altro?
    Credo sia un problema dell'editor del forum: si è mangiato l' = (uguale), che sicuramente nel codice c'è e ci deve essere per funzionare.
    Codice: 
    Err.Number = 0
    Capita, quando non mi collego dal pc di case, anche con certe combinazioni deii segni di < >, forse vengono interpretati come smile.
    Bye!
    scossa
    scossa's web site
    ___
    Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

  7. #5

    L'avatar di scossa
    Clicca e Apri
    Data Registrazione
    Jul 2015
    Località
    Verona Provincia
    Età
    57
    Messaggi
    1011
    Versione Office
    .
    Likes ricevuti
    365
    Likes dati
    0

    Re: [Tutorial VBA] Funzione FILTER

    Citazione Originariamente Scritto da scossa Visualizza Messaggio
    Credo sia un problema dell'editor del forum: si è mangiato l' = (uguale), che sicuramente nel codice c'è e ci deve essere per funzionare.
    Codice: 
    Err.Number = 0
    Capita, quando non mi collego dal pc di case, anche con certe combinazioni deii segni di < >, forse vengono interpretati come smile.
    Scusate, 'sta cosa dell'editor mi innervosisce.

    Ovviamente il messaggio deve apparire solo in caso di errore quindi

    If Err.Number <> 0 Then ....

    Scusate ancora.
    Bye!
    scossa
    scossa's web site
    ___
    Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

  8. #6
    L'avatar di Marius44
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Catania
    Età
    73
    Messaggi
    3207
    Versione Office
    Excel2010
    Likes ricevuti
    625
    Likes dati
    155

    Re: [Tutorial VBA] Funzione FILTER

    Ciao scossa
    ma IF ERR ... dovrebbe significare che se ERR è ... qualcosa, allora dà il messaggio. Quindi dovrebbe bastare solo IF ERR

    Ti aggiungo che ho provato senza uguale e senza diverso e ... funziona.
    E' la vecchiaia o il caldo. Boh ...

    Ciao,
    Mario

  9. #7

    L'avatar di scossa
    Clicca e Apri
    Data Registrazione
    Jul 2015
    Località
    Verona Provincia
    Età
    57
    Messaggi
    1011
    Versione Office
    .
    Likes ricevuti
    365
    Likes dati
    0

    Re: [Tutorial VBA] Funzione FILTER

    Ciao Mario,


    quello che dici è corretto.
    Io però, poiché proprietà Err.Number restituisce un valore numerico (Long) mentre l'istruzione If si aspetta un'espressione che dia come risultato un valore logico (True o False), normalmente preferisco indicare esplicitamente il test da verificare (questione di abitudine e stile di scrittura).
    Bye!
    scossa
    scossa's web site
    ___
    Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

Discussioni Simili

  1. Nuovi video tutorial di vba in italiano
    Di ges nel forum Domande su Excel VBA e MACRO
    Risposte: 23
    Ultimo Messaggio: 21/10/17, 18:04
  2. [Tutorial] Video Tutorial Ms Access canale Youtube
    Di CisKo nel forum Domande su Microsoft Access
    Risposte: 20
    Ultimo Messaggio: 18/11/16, 18:09
  3. Tutorial video by PKrome
    Di G.Bove nel forum Problemi, suggerimenti e Novità del forum
    Risposte: 3
    Ultimo Messaggio: 19/10/16, 22:48
  4. i tutorial
    Di D@nilo nel forum Domande su Excel in generale
    Risposte: 5
    Ultimo Messaggio: 25/02/16, 00:24
  5. Tutorial access
    Di tyran nel forum Domande su Microsoft Access
    Risposte: 2
    Ultimo Messaggio: 18/10/15, 13:06

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •