Risultati da 1 a 29 di 29

Discussione: Definire area su cui cercare i dati univoci



  1. #1
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636

    Definire area su cui cercare i dati univoci

    Un saluto a tutti,
    Scusatemi se ritorno su un argomento gia discusso e risolto piu volte ma poichè non soddisfa appieno la mia esigenza sono qui a cercare, se possibile e con il vostro aiuto, una soluzione.
    espongo il mio problema:
    ho una macro, proposta da cromagno, che mi crea un elenco univoco di nomi estrapolati da una tabella ad una determinata data, che funziona.
    il mio problema è che quando mi và a cercare i dati in una tabella di circa 10000 righe impiega moltissimo tempo, circa 4 minuti.
    suppongo che la macro faccia un ciclo di ricerche su tutta la tabella, ovviamente piu lunga è e piu si allungano i tempi.
    Quindi vorrei limitare la ricerca dei dati solo a quella interessata.
    vorrei, a questo punto, prima trovare la riga in cui si trova la prima data, che è l' inizio
    poi trovare la riga in cui si trova la seconda data, che è la fine
    quindi il ciclo for inizierebbe dal risultato della prima riga al risultato della seconda riga
    e in quest' area definita, che è sicuramente ridotta rispetto alla tabella, estrapolare i dati univoci a seconda di altre condizioni
    si potrebbe fare uso di un foglio di appoggio se necessario.....
    Tutto questo ragionamento non sò se ha una logica, per excel, e se magari può portare a migliorie.
    Attendo vostri suggerimenti o commenti....
    Grazie
    allego file con la macro....
    File Allegati File Allegati
    Windows8.1 office 2010

  2. #2

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4016
    Versione Office
    2013
    Likes ricevuti
    1225
    Likes dati
    923
    Ciao Vincenzo,
    allega un file d'esempio su cui poter lavorare.

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  3. #3
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    caricato?
    Windows8.1 office 2010

  4. #4

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4016
    Versione Office
    2013
    Likes ricevuti
    1225
    Likes dati
    923
    In pratica nel codice ci sarebbe da cambiare solo questa riga per renderla dinamica ??? :

    Codice: 
    For i = 4 To uRiga
    Ma le date di inizio e fine da che celle le prendo?

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  5. #5
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Citazione Originariamente Scritto da cromagno Visualizza Messaggio
    In pratica nel codice ci sarebbe da cambiare solo questa riga per renderla dinamica ??? :

    Codice: 
    For i = 4 To uRiga
    Ma le date di inizio e fine da che celle le prendo?
    Dal foglio Stat_Azienda cella C2 C3
    Windows8.1 office 2010

  6. #6

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7125
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2063
    Likes dati
    1298
    Strano .... ho provato con 10.000 righe e il contatore ha impiegato solo 0,13 secondi!
    Presumo dipenda anche dalla potenza del computer in uso.
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  7. #7

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4016
    Versione Office
    2013
    Likes ricevuti
    1225
    Likes dati
    923
    Ma se sono sempre quelle date, ti basta cambiare la riga di prima in questo modo:

    Codice: 
    For i = Data1 To Data2
    Quindi il codice intero:

    Codice: 
    Sub EliminaDuplicati3condizioni()
       'Cromagno
       
        Dim wks As Worksheet, Data1 As Date, Data2 As Date
        Dim uRiga As Long, Univoci As Collection, i As Long, nome As String
        
        Application.ScreenUpdating = False
        Set Univoci = New Collection
        Set wks = Worksheets("ARCHIVIO COMMISSIONI")
        Data1 = Range("C2").Value
        Data2 = Range("C3").Value
        nome = Range("A5").Value
        
        With wks
            uRiga = .Range("E" & Rows.Count).End(xlUp).Row  'conta le righe della colonna E del foglio Archivio commissioni
            Range("A9:A" & Rows.Count).ClearContents        ' cancello le righe della colonna A fino alla riga A9 del foglio attivo
            On Error Resume Next
            
            For i = Data1 To Data2     ' inizio dalla riga 4 del foglio Archivio commissioni
            
                If .Cells(i, 4).Value >= Data1 And .Cells(i, 4).Value <= Data2 And .Cells(i, 6).Value = nome Then 'cerco i valori delle condizioni nelle colonne del foglio archivio commissioni
                    Univoci.Add .Cells(i, 5).Value, CStr(.Cells(i, 5).Value)  'cerco i valori univoci,visto le condizioni, nella colonna di riferimento
                    
                End If
            Next i
            On Error GoTo 0
            ' copio i valori univoci della collection nel range di riferimento del foglio attivo
            For i = 1 To Univoci.Count
                Range("A" & i + 8).Value = Univoci(i)
            Next i
            
            Range("A5").Select
        End With
        Set wks = Nothing
       
        Application.ScreenUpdating = True
    End Sub
    [EDIT]
    Scusa... mi sa che ho detto una str......a...
    sono un pò di fretta e l'ho buttata lì.

    Ti faccio sapere tra un pò.

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  8. #8
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Citazione Originariamente Scritto da ges Visualizza Messaggio
    Strano .... ho provato con 10.000 righe e il contatore ha impiegato solo 0,13 secondi!
    In questa tabella funziona egregiamente, forse perché i dati da analizzare con la terza condizione sono sempre i soliti e pochi...
    nel mio caso deve analizzare una serie di commissioni i cui clienti sono circa cento e ognuna di queste sono da associare a 12 aziende diverse
    è sicuramente questa situazione che fa allungare i tempi.....
    Windows8.1 office 2010

  9. #9
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Citazione Originariamente Scritto da cromagno Visualizza Messaggio
    Ma se sono sempre quelle date, ti basta cambiare la riga di prima in questo modo:

    Codice: 
    For i = Data1 To Data2
    Quindi il codice intero:

    Codice: 
    Sub EliminaDuplicati3condizioni()
       'Cromagno
       
        Dim wks As Worksheet, Data1 As Date, Data2 As Date
        Dim uRiga As Long, Univoci As Collection, i As Long, nome As String
        
        Application.ScreenUpdating = False
        Set Univoci = New Collection
        Set wks = Worksheets("ARCHIVIO COMMISSIONI")
        Data1 = Range("C2").Value
        Data2 = Range("C3").Value
        nome = Range("A5").Value
        
        With wks
            uRiga = .Range("E" & Rows.Count).End(xlUp).Row  'conta le righe della colonna E del foglio Archivio commissioni
            Range("A9:A" & Rows.Count).ClearContents        ' cancello le righe della colonna A fino alla riga A9 del foglio attivo
            On Error Resume Next
            
            For i = Data1 To Data2     ' inizio dalla riga 4 del foglio Archivio commissioni
            
                If .Cells(i, 4).Value >= Data1 And .Cells(i, 4).Value <= Data2 And .Cells(i, 6).Value = nome Then 'cerco i valori delle condizioni nelle colonne del foglio archivio commissioni
                    Univoci.Add .Cells(i, 5).Value, CStr(.Cells(i, 5).Value)  'cerco i valori univoci,visto le condizioni, nella colonna di riferimento
                    
                End If
            Next i
            On Error GoTo 0
            ' copio i valori univoci della collection nel range di riferimento del foglio attivo
            For i = 1 To Univoci.Count
                Range("A" & i + 8).Value = Univoci(i)
            Next i
            
            Range("A5").Select
        End With
        Set wks = Nothing
       
        Application.ScreenUpdating = True
    End Sub
    [EDIT]
    Scusa... mi sa che ho detto una str......a...
    sono un pò di fretta e l'ho buttata lì.

    Ti faccio sapere tra un pò.
    le date variano a seconda del periodo che mi interessa analizzare
    Windows8.1 office 2010

  10. #10
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    data1 e data2 mi dovrebbero dare un numero di riga di cui deve tener presente il ciclo for ..... riga inizio e fine
    Windows8.1 office 2010

  11. #11

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4016
    Versione Office
    2013
    Likes ricevuti
    1225
    Likes dati
    923
    Ciao,

    allora... per evitare altri cicli per trovare la riga di inizio e fine, potresti usare queste due righe (in rosso le modifiche):

    Codice: 
    Sub EliminaDuplicati3condizioni()
       'Cromagno
       
        Dim wks As Worksheet, Data1 As Date, Data2 As Date
        Dim uRiga As Long, Univoci As Collection, i As Long, nome As String
        Dim Inizio As Long, Fine As Long
        
        Application.ScreenUpdating = False
        Set Univoci = New Collection
        Set wks = Worksheets("ARCHIVIO COMMISSIONI")
        Data1 = Range("C2").Value
        Data2 = Range("C3").Value
        nome = Range("A5").Value
        
        With wks
            uRiga = .Range("E" & Rows.Count).End(xlUp).Row  'conta le righe della colonna E del foglio Archivio commissioni
            Range("A9:A" & Rows.Count).ClearContents        ' cancello le righe della colonna A fino alla riga A9 del foglio attivo
            Inizio = .Range("D4:D" & uRiga).Find(Data2, LookIn:=xlValues).Row
            Fine = .Range("D4:D" & uRiga).Find(Data1, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
            
            On Error Resume Next
            
            For i = Inizio To Fine     
            
                If .Cells(i, 4).Value >= Data1 And .Cells(i, 4).Value <= Data2 And .Cells(i, 6).Value = nome Then 'cerco i valori delle condizioni nelle colonne del foglio archivio commissioni
                    Univoci.Add .Cells(i, 5).Value, CStr(.Cells(i, 5).Value)  'cerco i valori univoci,visto le condizioni, nella colonna di riferimento
                    
                End If
            Next i
            On Error GoTo 0
            ' copio i valori univoci della collection nel range di riferimento del foglio attivo
            For i = 1 To Univoci.Count
                Range("A" & i + 8).Value = Univoci(i)
            Next i
            
            Range("A5").Select
        End With
        Set wks = Nothing
       
        Application.ScreenUpdating = True
    End Sub
    le date devono essere presenti altrimenti bisogna gestire l'errore....
    ti riallego il file.....
    File Allegati File Allegati

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  12. #12
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Ok
    Sono con il cellulare..
    Appena possibile ti faccio sapere...
    Grazie
    Windows8.1 office 2010

  13. #13
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Ciao Cromagno,
    Provando il file ho notato che cambiando la data và in errore:
    Variabile oggetto o variabile del blocco With non impostata
    Inizio = .Range("D4:D" & uRiga).Find(Data2, LookIn:=xlValues).Row
    Forse bisogna impostarla in modo che se non trova la data uguale a quella impostata sarà la prima successiva?
    Grazie
    Windows8.1 office 2010

  14. #14

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4016
    Versione Office
    2013
    Likes ricevuti
    1225
    Likes dati
    923
    Ciao,
    si, te l'ho scritto:
    la data deve essere presente altrimenti bisogna aggiungere qualche riga per gestire l'errore.

    Come ti ho detto ero un pò di fretta... se non ti aiuta qualcun'altro, ci metterò mano domani sera.

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  15. #15
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Ci conto,
    Grazie
    Windows8.1 office 2010

  16. #16
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Buongiorno Cromagno,
    ho aggiunto le tue correzioni sul mio file e i tempi di calcolo sono passati a circa 45 secondi, da quasi 4 minuti....
    sicuramente molto molto meglio...
    attendo la correzione degli errori...
    Grazie mille
    Windows8.1 office 2010

  17. #17

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4016
    Versione Office
    2013
    Likes ricevuti
    1225
    Likes dati
    923
    Citazione Originariamente Scritto da Vincenzo Damiani Visualizza Messaggio
    Buongiorno Cromagno,
    ho aggiunto le tue correzioni sul mio file e i tempi di calcolo sono passati a circa 45 secondi, da quasi 4 minuti....
    sicuramente molto molto meglio...
    attendo la correzione degli errori...
    Grazie mille
    Ciao a tutti,

    @Vincenzo
    45 secondi per sole 10.000 righe di dati mi sembrano comunque eccessivi :256:

    Prima di passare a "gestire gli errori" dopo l'aggiunta delle variabili "Inizio" e "Fine", farei una prova utilizzando una matrice nel codice (quindi i controlli verranno fatti in quella matrice e non nel foglio).

    Ho fatto una prova con 250.000 righe e ci mette comunque 4 o 5 secondi.
    Fai una prova...
    Il codice è questo:

    Codice: 
    Sub EliminaDuplicatiMatrice()
       'Cromagno
       
        Dim wks As Worksheet, wks2 As Worksheet, Data1 As Date, Data2 As Date
        Dim uRiga As Long, Univoci As Collection, i As Long, nome As String
        Dim Matrice(), j As Long
        
        Application.ScreenUpdating = False
        Set Univoci = New Collection
        Set wks = Worksheets("ARCHIVIO COMMISSIONI")
        Set wks2 = Worksheets("Stat_Azienda")
        Data1 = wks2.Range("C2").Value
        Data2 = wks2.Range("C3").Value
        nome = wks2.Range("A5").Value
        
        With wks
            uRiga = .Range("E" & Rows.Count).End(xlUp).Row  'conta le righe della colonna E del foglio Archivio commissioni
            ReDim Matrice(1 To uRiga, 1 To 3)               'imposto la grandeza della matrice
            Range("A9:A" & Rows.Count).ClearContents        ' cancello le righe della colonna A fino alla riga A9 del foglio attivo
            
            For i = 1 To 3                                  'Carico i dati nella matrice
                For j = 1 To uRiga
                    Matrice(j, i) = .Cells(j + 3, i + 3)
                Next j
            Next i
            
            On Error Resume Next
            
            For i = 1 To uRiga
                If Matrice(i, 1) >= Data1 And Matrice(i, 1) <= Data2 And Matrice(i, 3) = nome Then 'cerco i valori delle condizioni nelle colonne del foglio archivio commissioni
                    Univoci.Add Matrice(i, 2), CStr(Matrice(i, 2))  'cerco i valori univoci,visto le condizioni, nella colonna di riferimento
                End If
            Next i
            On Error GoTo 0
            
            ' copio i valori univoci della collection nel range di riferimento del foglio attivo
            For i = 1 To Univoci.Count
                Range("A" & i + 8).Value = Univoci(i)
            Next i
            
            Range("A5").Select
        End With
        Set wks = Nothing
        Set wks2 = Nothing
        Set Univoci = Nothing
        Application.ScreenUpdating = True
    End Sub
    Ti riallego il file (il nuovo codice è associato al nuovo pulsante con il testo in rosso).
    File Allegati File Allegati

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  18. #18
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Citazione Originariamente Scritto da cromagno Visualizza Messaggio
    Ciao a tutti,

    @Vincenzo
    45 secondi per sole 10.000 righe di dati mi sembrano comunque eccessivi :256:

    Prima di passare a "gestire gli errori" dopo l'aggiunta delle variabili "Inizio" e "Fine", farei una prova utilizzando una matrice nel codice (quindi i controlli verranno fatti in quella matrice e non nel foglio).

    Ho fatto una prova con 250.000 righe e ci mette comunque 4 o 5 secondi.
    Fai una prova...
    Il codice è questo:

    Codice: 
    Sub EliminaDuplicatiMatrice()
       'Cromagno
       
        Dim wks As Worksheet, wks2 As Worksheet, Data1 As Date, Data2 As Date
        Dim uRiga As Long, Univoci As Collection, i As Long, nome As String
        Dim Matrice(), j As Long
        
        Application.ScreenUpdating = False
        Set Univoci = New Collection
        Set wks = Worksheets("ARCHIVIO COMMISSIONI")
        Set wks2 = Worksheets("Stat_Azienda")
        Data1 = wks2.Range("C2").Value
        Data2 = wks2.Range("C3").Value
        nome = wks2.Range("A5").Value
        
        With wks
            uRiga = .Range("E" & Rows.Count).End(xlUp).Row  'conta le righe della colonna E del foglio Archivio commissioni
            ReDim Matrice(1 To uRiga, 1 To 3)               'imposto la grandeza della matrice
            Range("A9:A" & Rows.Count).ClearContents        ' cancello le righe della colonna A fino alla riga A9 del foglio attivo
            
            For i = 1 To 3                                  'Carico i dati nella matrice
                For j = 1 To uRiga
                    Matrice(j, i) = .Cells(j + 3, i + 3)
                Next j
            Next i
            
            On Error Resume Next
            
            For i = 1 To uRiga
                If Matrice(i, 1) >= Data1 And Matrice(i, 1) <= Data2 And Matrice(i, 3) = nome Then 'cerco i valori delle condizioni nelle colonne del foglio archivio commissioni
                    Univoci.Add Matrice(i, 2), CStr(Matrice(i, 2))  'cerco i valori univoci,visto le condizioni, nella colonna di riferimento
                End If
            Next i
            On Error GoTo 0
            
            ' copio i valori univoci della collection nel range di riferimento del foglio attivo
            For i = 1 To Univoci.Count
                Range("A" & i + 8).Value = Univoci(i)
            Next i
            
            Range("A5").Select
        End With
        Set wks = Nothing
        Set wks2 = Nothing
        Set Univoci = Nothing
        Application.ScreenUpdating = True
    End Sub
    Ti riallego il file (il nuovo codice è associato al nuovo pulsante con il testo in rosso).
    Ciao Cromagno,
    Non riesco a far funzionare la macro sul mio file :292::292::292:
    eppure credo di aver adattato tutti i parametri cosi come ho fatto per quella precedente....
    la macro gira pochi secondi, ma non riporta i dati sul foglio:187::187:
    mentre sul file da te inviato funziona alla grande, eccetto quei errori sulle date da gestire
    hai qualche suggerimento in merito?
    Grazie ancora per la pazienza
    Windows8.1 office 2010

  19. #19

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4016
    Versione Office
    2013
    Likes ricevuti
    1225
    Likes dati
    923
    Ciao Vincenzo,
    purtroppo senza vedere i tuoi adattamenti (e soprattutto se sono corretti per la struttura del tuo file) non saprei cosa consigliarti. :273:

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  20. #20
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Citazione Originariamente Scritto da cromagno Visualizza Messaggio
    Ciao Vincenzo,
    purtroppo senza vedere i tuoi adattamenti (e soprattutto se sono corretti per la struttura del tuo file) non saprei cosa consigliarti. :273:
    Ok Cromagno
    trovato inghippo
    provato la macro ma impiega dai 2 minuti ai 2 minuti e 10 secondi.....
    non credo che le formule possano fare meglio di una macro....non capisco il motivo..:92:
    a questo punto non vorrei impegnarti più di tanto....
    vedi tu....
    io ti ringrazio tantissimo per quello che hai fatto....
    se riesci a trovare una soluzione io sono qui...
    grazie grazie grazie:98::246:
    Windows8.1 office 2010

  21. #21

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4016
    Versione Office
    2013
    Likes ricevuti
    1225
    Likes dati
    923
    Ciao,
    con "trovare una soluzione" intendi "velocizzare il processo"?
    Io sinceramente non capisco perchè con il tuo file impieghi così tanto e credo che l'unico modo sia proprio lavorare sul file originale ma visto che non l'hai ancora allegato, immagino perchè ci siano dati sensibili.
    A questo punto posso solo andare per tentativi....
    Stanotte proverò un'altra strada.

    Solo per curiosità, mi potresti dire il processore e la RAM del pc sul quale gira il codice?!?

    Ciao
    Tore

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  22. #22

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4016
    Versione Office
    2013
    Likes ricevuti
    1225
    Likes dati
    923
    Facciamo un altro tentativo....questa volta aggiungendo dei filtri (sempre tramite codice).
    Ho cercato di gestire gli errori che mi sono venuti in mente ma magari ne ho saltato qualcuno....

    Codice: 
    Option Explicit
    
    
    Sub EliminaDuplicatiFiltri()
       'Cromagno
       
        Dim wks As Worksheet, wks2 As Worksheet, Data1 As Date, Data2 As Date
        Dim uRiga As Long, Univoci As Collection, i As Long, nome As String
        Dim Matrice(), Cella As Range, Campo_filtro As Range, Riga As Long
        Dim Minimo As Date, Massimo As Date, Errore
        
        Set Univoci = New Collection
        Set wks = Worksheets("ARCHIVIO COMMISSIONI")
        Set wks2 = Worksheets("Stat_Azienda")
        Data1 = wks2.Range("C2").Value
        Data2 = wks2.Range("C3").Value
        nome = wks2.Range("A5").Value
        
        Application.ScreenUpdating = False
        
        Range("A9:A" & Rows.Count).ClearContents        ' cancello le righe della colonna A fino alla riga A9 del foglio attivo
        With wks
            uRiga = .Range("E" & Rows.Count).End(xlUp).Row  'conta le righe della colonna E del foglio Archivio commissioni
            
            If .Range("D3").Value <> "" Then                'mi calcolo la data minore e maggiore a disposizione
                Minimo = Application.WorksheetFunction.Min(.Range("D3:D" & uRiga))
            Else
                Minimo = Application.WorksheetFunction.Min(.Range("D4:D" & uRiga))
            End If
            Massimo = Application.WorksheetFunction.Max(.Range("D3:D" & uRiga))
            
            'Controllo che i criteri inseriti siano corretti
            If Data1 > Data2 Or Data1 < Minimo Or Data2 > Massimo Or nome = "" Then
                Errore = MsgBox("Controllare che i dati inseriti come criteri siano corretti", vbCritical, _
                "ERRORE INSERIMENTO DATI...")
                Exit Sub
            End If
            
            If wks.FilterMode = True Then
                wks.ShowAllData
            End If
            .Range("A2:F2").AutoFilter Field:=4, Criteria1:=">=" & Format(Data1, "mm/dd/yyyy"), Operator:=xlAnd, _
            Criteria2:="<=" & Format(Data2, "mm/dd/yyyy")
            .Range("A2:F2").AutoFilter Field:=6, Criteria1:=nome
            
            On Error GoTo messaggio
            uRiga = .Range("E3:E" & uRiga).SpecialCells(xlCellTypeVisible).Count
            If uRiga = 1 Then
    messaggio:
                MsgBox "Non è stata trovata nessuna voce."
                wks.ShowAllData
                Exit Sub
            End If
            Set Campo_filtro = .Range("E3:E" & uRiga).SpecialCells(xlCellTypeVisible)
            ReDim Matrice(1 To uRiga)               'imposto la grandeza della matrice
            Riga = 1
            For Each Cella In Campo_filtro                  'Carico i dati nella matrice
                Matrice(Riga) = Cella.Value
                Riga = Riga + 1
            Next
         
            On Error Resume Next
    
    
            For i = 1 To UBound(Matrice)
                Univoci.Add Matrice(i), CStr(Matrice(i))  'cerco i valori univoci,visto le condizioni, nella colonna di riferimento
            Next i
            On Error GoTo 0
            
            ' copio i valori univoci della collection nel range di riferimento del foglio attivo
            For i = 1 To Univoci.Count
                Range("A" & i + 8).Value = Univoci(i)
            Next i
            
            Range("A5").Select
        End With
        Set wks = Nothing
        Set wks2 = Nothing
        Set Univoci = Nothing
        Application.ScreenUpdating = True
    End Sub
    Nel file allegato questo codice è associato al terzo pulsante (con il testo in blu).
    File Allegati File Allegati

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  23. #23
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Buongiorno Cromagno,
    Ti ringrazio per non aver abbandonato la discussione.
    provando la macro con il terzo pulsante, sul file inviato, mi dice: Controllare che i dati inseriti come criteri siano esatti...
    cosa devo controllare?
    le due precedenti funzionano....
    Grazie
    Windows8.1 office 2010

  24. #24
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Ok
    Trovato....l'errore lo genera se la data inserita non è compresa tra quelle da analizzare....
    ma non si può gestire dicendo: cerca la prima data uguale o maggiore di quella inserita?....
    in giornata la provo sul mio file e ti dico...
    grazie e buona giornata
    Windows8.1 office 2010

  25. #25

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4016
    Versione Office
    2013
    Likes ricevuti
    1225
    Likes dati
    923
    si, ma non mi sembrava "corretto"...
    Comunque se guardi il codice, puoi mettere la condizione che se Data1 è minore di Minimo allora:
    Data1=Minimo

    stessa cosa per Data2 e Massimo (naturalmente questa volta userai "maggiore" come confronto, non "minore").

    Ho solo il cell adesso... è per questo che non "oso" scrivere nulla in VBA ;)

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  26. #26
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Ok grazie
    Windows8.1 office 2010

  27. #27
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Ciao Cromagno,
    dando per certo quello che sostenevi nel post #17 "Ho fatto una prova con 250.000 righe e ci mette comunque 4 o 5 secondi"
    ho cercato di individuare il problema concentrandomi su altro e, a mia sorpresa è successo quanto di seguito:
    Avevo delle macro impostate nel foglio su cui stavo lavorando, queste

    'attiva calcolo automatico delle formule nel foglio attivo
    Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.Calculate
    End Sub

    'aprire l'elenco della convalida dati quando la cella è attiva
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$B$2" Then Application.SendKeys ("%{DOWN}")
    End Sub

    Cancellandole ho notato che, sia la prima soluzione che la seconda soluzione da te proposte, funzionano alla grande....:255::97::274::18:
    Io non sò darmi una spiegazione....
    Se c'è una logica fammelo sapere....

    pertanto ti ringrazio per l'ennesima volta per avermi dedicato del tempo

    grazie grazie e ancora grazie, per aver risolto il mio problema....
    Ciao
    Windows8.1 office 2010

  28. #28

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4016
    Versione Office
    2013
    Likes ricevuti
    1225
    Likes dati
    923
    Ciao Vincenzo,

    beh si... avrei dovuto pensarci ma nel file allegato non serviva.

    Se ci sono molte formule nel foglio, queste essendo "volatili" vengono aggiornate ad ogni cambiamento del foglio rallentando molto l'esecuzione del codice.

    Di solito si ovvia a questo mettendo all'inizio del codice questa istruzione:

    Codice: 
    Application.Calculation = xlCalculationManual
    e questa alla fine (o comunque prima di un'uscita forzata...esempio "Exit Sub"):

    Codice: 
    Application.Calculation = xlCalculationAutomatic

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  29. #29
    L'avatar di Vincenzo Damiani
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Molfetta
    Età
    58
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    13
    Likes dati
    636
    Ciao Cromagno,
    Farò tesoro dei tuoi consigli..
    metto risolto questa discussione
    Grazie
    Windows8.1 office 2010

Discussioni Simili

  1. Copiare dati univoci su altro foglio
    Di totorom1 nel forum Domande su Excel in generale
    Risposte: 11
    Ultimo Messaggio: 20/02/17, 16:20
  2. Somma se in presenza di dati univoci
    Di G.Bove nel forum Domande su Excel in generale
    Risposte: 19
    Ultimo Messaggio: 25/02/16, 15:13
  3. Combobox a cascata dati univoci
    Di nessi nel forum Domande su Excel VBA e MACRO
    Risposte: 9
    Ultimo Messaggio: 29/12/15, 00:12
  4. [Risolto] dati univoci tramite funzione
    Di annnndrea nel forum Domande su Excel in generale
    Risposte: 16
    Ultimo Messaggio: 15/10/15, 22:19
  5. Convalida dati da elenco per dati univoci dinamica
    Di tsunami1978 nel forum Domande su Excel in generale
    Risposte: 8
    Ultimo Messaggio: 27/08/15, 00:52

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
  •