Trovare valori ripetuti

[ricky53]

ciao,
Ovviamente non volevo copia del cartaceo ma un tuo file excel con piu' dati per verificare il codice che ho scritto
Senza dati riservati e' scontato!

[grankio]

Ahahaha ok ok,lunedì t mando uno più aggiornato intanto lo posso provare copiando più volte i dati che c sono in quello di giovedi

[grankio]

Il mio unico dubbio sai qual è.? Se due dilazioni che riguardano due fatture diverse(di cui nn c e numero d fattura) hanno la stessa data di scadenza le cancella?

[ricky53]

. No, non cancella perche' ho costruito la chiave. Al momento ... attendi ed avrai la soluzione forse in serata

[ricky53]

Ciao,
come promesso ecco il nuovo codice.


Esegui i passi successivi in modo scrupoloso:
Allora:
1. UTILIZZA il FILE che ci hai inviato perchè io ho lavorato su quello !!!
2. Copia le macro in un modulo (dal foglio excel premi "Alt+F11", VBAProject, Microsoft Excel Oggetti, Tasto destro, Inserisci, Modulo, nella finestra di destra copia il codice che trovi alla fine
3. Con "F5" esegui il la macro "Elabora_e_Cancella"
4. Fai le verifiche controllando le colonne "N:S" che vengono scritte dalla macro, le intestazioni sono esplicative
5. Filtra sulla colonna "R" per ">1" e controlla le righe filtrate (sono quelle di colore giallo) perchè queste sono le righe che verranno cancellate
6. A controllo fatto esegui la macro "Cancella_Righe"
7. Fai l'ultimo controllo con il file iniziale
8. Togli l'apice all'istruzione

Codice: Seleziona tutto

'    Call Cancella_Righe  ' <<====== QUESTA MACRO va eseguita solo dopo aver fatto le verifiche

A questo punto la macro è pronta per essere eseguita quante volte vuoi e tu non devi fare nulla se non RICONTROLLARE dopo aver eseguito la macro sul file originale e Speriamo che sia quello che avevi chiesto.

Codice: Seleziona tutto

Option Explicit
Public UR As Long, I As Long

Sub Elabora_e_Cancella()
   
    Call Copia_e_Imposta_Formati
   
    UR = Range("E" & Rows.Count).End(xlUp).Row
    Range("A2:S" & UR).Select
    Selection.AutoFilter Field:=5, Criteria1:="<>"
    ActiveSheet.ShowAllData

    Range("N2:S" & UR).Clear
   
    Range("N2") = "N. Docum."
    Range("O2") = "Progr. Docum."
    Range("P2") = "Data Scadenza"
    Range("Q2") = "Chiave"
    Range("R2") = "Righe Duplicate"
    Range("S2") = "Progr. Iniziale"
    Range("S3") = 1
    Range("S4") = 2
    Range("S3:S4").Select
    Selection.AutoFill Destination:=Range("S3:S" & UR), Type:=xlFillDefault

    UR = Range("E" & Rows.Count).End(xlUp).Row
    For I = 3 To UR
        If Cells(I, "B") = "" Then
            Cells(I, "N") = Cells(I - 1, "N")
            Cells(I, "O") = Cells(I - 1, "O") + 1
        Else
            Cells(I, "N") = Cells(I, "B")
            Cells(I, "O") = 0
        End If
        Cells(I, "P") = Cells(I, "E")
        Cells(I, "Q") = Cells(I, "N") & "-" & Cells(I, "O")
    Next I
   
    Range("R3:R" & UR).FormulaR1C1 = "=COUNTIF(RC[-1]:R100C[-1], RC[-1])"
    Range("A2:S" & UR).Select
    Selection.Sort Key1:=Range("Q3"), Order1:=xlAscending, Key2:=Range("R3") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
   
    Range("R3:R" & UR).Copy
    Range("R3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("N:S").EntireColumn.AutoFit
       
    UR = Range("E" & Rows.Count).End(xlUp).Row
    Selection.AutoFilter Field:=5, Criteria1:="<>"
    ActiveSheet.ShowAllData
    Selection.AutoFilter Field:=18, Criteria1:=">1", Operator:=xlAnd
    Range("N3:S" & UR).Interior.ColorIndex = 6
    ActiveSheet.ShowAllData

'..................................................................................................
'    Call Cancella_Righe  ' <<====== QUESTA MACRO va eseguita solo dopo aver fatto le verifiche
'..................................................................................................
   
    Application.ScreenUpdating = True
    MsgBox "Elaborazione Effettuata"
End Sub

Sub Copia_e_Imposta_Formati()
    Sheets("Volume affari").Select
    Cells.Delete Shift:=xlUp
    With Cells
        .VerticalAlignment = xlCenter
        .Interior.ColorIndex = xlNone
    End With
   
    Sheets("Provvigioni contabilizzate").Select
    Columns("A:G").Select
    Selection.Copy
    Sheets("Volume affari").Select
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C:C,E:E").Select
    Selection.NumberFormat = "m/d/yyyy"
    Range("A1").Copy
    Range("B1:G1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("A:G").Select
    Columns("A:G").EntireColumn.AutoFit
End Sub

Sub Cancella_Righe()
    Sheets("Volume affari").Select
    UR = Range("E" & Rows.Count).End(xlUp).Row
    Range("A2:S" & UR).Select
    Selection.AutoFilter Field:=5, Criteria1:="<>"
    ActiveSheet.ShowAllData
    Selection.AutoFilter Field:=18, Criteria1:=">1", Operator:=xlAnd
    UR = Range("B" & Rows.Count).End(xlUp).Row
    If UR > 2 Then
        Rows("3:" & UR).Delete Shift:=xlUp
    End If
    ActiveSheet.ShowAllData
    Selection.AutoFilter
    UR = Range("E" & Rows.Count).End(xlUp).Row
    Range("A2:S" & UR).Select
    Selection.Sort Key1:=Range("S3"), Order1:=xlAscending, Key2:=Range("R3") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Range("N2:S" & UR).Clear
    Range("A2").Select
End Sub


[ricky53]

Ciao,
una piccola correzione vai nel codice e cerca le istruzioni seguenti:

Codice: Seleziona tutto

UR = Range("E" & Rows.Count).End(xlUp).Row
    Selection.AutoFilter Field:=5, Criteria1:="<>"
    ActiveSheet.ShowAllData
    Range("A2:S" & UR).Select ' <<====== AGGIUNTA !!!
    Selection.AutoFilter Field:=18, Criteria1:=">1", Operator:=xlAnd
    Range("N3:S" & UR).Interior.ColorIndex = 6
    ActiveSheet.ShowAllData

'..................................................................................................
'    Call Cancella_Righe  ' <<====== QUESTA MACRO va eseguita solo dopo aver fatto le verifiche
'..................................................................................................

Aggiungi l'istruzione evidenziata con "AGGIUNTA", nel punto dove l'ho scritta io.

[grankio]

ciao provata mi da errore nel metodo autofilter per classe range se faccio debug mi indica questo rigo

Codice: Seleziona tutto

Selection.AutoFilter Field:=18, Criteria1:=">1", Operator:=xlAnd   

[grankio]

ora a funzionato cmq non mi mantiene l ordine originale ma le riordina a modo suo

[ricky53]

Ciao,
non era necessario copiare tuto il codicei e senza i TAG !

Non mi convince sia l'errore che la questione dell'ordinamento errato.

Hai provato sul file che avevi inserito nel forum oppure su un altro file?
Quali passi hai fatto dopo aver aperto il file?


Invia il file sul quale hai provato in modo che io possa fare un riscontro.

[grankio]

ciao , ho fatto cosi
1 copia del file;
2 ho copiato i valori di provvigioni contabilizzate da colonna B a G in volume d'affari;
3 ho inserito il modulo copiato
4 copiato la macro aggiungendo la riga che mi hai detto tu, ho fatto F5 e mi ha dato quell'errore poi ho dato un colpo di F8 e un altro F5 ed e andata,

non sono andato avanti xke ho controllato come li sistemava e cmq non ho ben capito cosa fare

questo e il mio file http://www.filedropper.com/definitivoprovamacro

[grankio]

ciao , ho fatto cosi
1 copia del file;
2 ho copiato i valori di provvigioni contabilizzate da colonna B a G in volume d'affari;
3 ho inserito il modulo copiato
4 copiato la macro aggiungendo la riga che mi hai detto tu, ho fatto F5 e mi ha dato quell'errore poi ho dato un colpo di F8 e un altro F5 ed e andata,

non sono andato avanti xke ho controllato come li sistemava e cmq non ho ben capito cosa fare

questo e il mio file http://www.filedropper.com/definitivoprovamacro

[ricky53]

Ciao,
a questo punto è necessaria una considerazione:
io sono paziente e lo si può vedere leggendo i tanti interventi fatti con te, ma tu fai di tutto per, se me lo concedi, "spazientirmi".
Secondo te perché io ti ho riportato i passi che dovevi fare descrivendoti “punto punto” cosa fare?
Perché NON avevo altro da fare oppure per farti provare nel MODO CORRETTO !!!!

Invece tu hai fatto altro, per esempio hai copiato i dati nel foglio "Volume affari"
Domanda: c'era questa azione nei punti che ti avevo scritto?



Torniamo al tuo quesito e questa è l'ultima volta che scrivo se NON FARAI quanto ti propongo:
1. scarica il file ZIP ed estrai il file excel
2. apri il file Excel
3. fai clik sull’ovale “Elabora”
4. a fine macro nel foglio "Volume affari" avrai le fatture copiate, alcune avranno lo sfondo "giallo", sono quelle duplicate che dovranno essere, successivamente, cancellate da un’altra macro
5. filtra fai tutti i controlli che ritieni necessari
6. fai clik sull’ovale “Elabora e Cancella”
7. a fine macro nel foglio "Volume affari" avrai SOLO le fatture NON duplicate (le colonne N-S contengono dati che ti posso aiutare a fare le verifiche, poi vanno cancellate, per fare questo leggi il commento nella macro “Cancella_Righe”, posto verso la fine della macro)

NON FARE ALTRI PASSI DIVERSI da QUELLI che ti ho scritto!!!

LINK al FILE di esempio

[grankio]

ok non avevo capito che la copia la facesse in automatico, devi sapere (cm gia avrai capito che per me e arabo) ade esempio non ho capito dove trovo il commento del punto 7, cmq grazie per la pazienza/ disponibilità cosi credo che vada bene, eventualmente noto cose strane t posto un file con più dati se hai tempo di guardarlo, altrimenti faccio a mano
ancora grazie buona serata

[ricky53]

Ciao,
appena avrai il file invialo, lo guarderò sicuramente.

In riferimento al punto "7" il commento lo trovi nel codice ed era solo di TOGLIERE l'apice ad una istruzione

Codice: Seleziona tutto

    Selection.Sort Key1:=Range("S3"), Order1:=xlAscending, Key2:=Range("R3") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
'    Range("N2:S" & UR).Clear ' <<===== TOGLI l'apice a questa istruzione dopo le verifiche
    Range("A2").Select


Questa istruzione

Codice: Seleziona tutto

Range("N2:S" & UR).Clear

cancella le celle utilizzate per fare l'elaborazione


IMPORTANTE !!!
LEGGI con MOLTA ATTENZIONE !!!

Quando lavorerai sul file reale non dovrai fare ALTRO che eseguire la macro "Elabora_e_Cancella" che trovi nel file di esempio che ti avevo inviato e che riporto

Codice: Seleziona tutto

Sub Elabora_e_Cancella()
' Questa macro copia i dati, trova le fatture duplicate ed infine "cancella" le fatture duplicate
   
    Call Elabora_0
   
    Call Cancella_Righe
   
    [A2].Select
    MsgBox "Elaborazione effettuata. Sono state cancellate tutte le fatture duplicate ", vbInformation
End Sub

che a sua volta richiama altre macro che trovi qui di seguito

Codice: Seleziona tutto

Sub Elabora_0()
   
    Call Copia_e_Imposta_Formati
   
    Sheets("Volume affari").Select
    UR = Range("E" & Rows.Count).End(xlUp).Row
    Range("A2:S" & UR).Select
    Selection.AutoFilter Field:=5, Criteria1:="<>"
    ActiveSheet.ShowAllData

    Range("N2:S" & UR).Clear
   
    Range("N2") = "N. Docum."
    Range("O2") = "Progr. Docum."
    Range("P2") = "Data Scadenza"
    Range("Q2") = "Chiave"
    Range("R2") = "Righe Duplicate"
    Range("S2") = "Progr. Iniziale"
    Range("S3") = 1
    Range("S4") = 2
    Range("S3:S4").Select
    Selection.AutoFill Destination:=Range("S3:S" & UR), Type:=xlFillDefault

    UR = Range("E" & Rows.Count).End(xlUp).Row
    For I = 3 To UR
        If Cells(I, "B") = "" Then
            Cells(I, "N") = Cells(I - 1, "N")
            Cells(I, "O") = Cells(I - 1, "O") + 1
        Else
            Cells(I, "N") = Cells(I, "B")
            Cells(I, "O") = 0
        End If
        Cells(I, "P") = Cells(I, "E")
        Cells(I, "Q") = Cells(I, "N") & "-" & Cells(I, "O")
    Next I
   
    Range("R3:R" & UR).FormulaR1C1 = "=COUNTIF(RC[-1]:R100C[-1], RC[-1])"
    Range("A2:S" & UR).Select
    Selection.Sort Key1:=Range("Q3"), Order1:=xlAscending, Key2:=Range("R3") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
   
    Range("R3:R" & UR).Copy
    Range("R3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("N:S").EntireColumn.AutoFit
       
    UR = Range("E" & Rows.Count).End(xlUp).Row
    Selection.AutoFilter Field:=5, Criteria1:="<>"
    ActiveSheet.ShowAllData
    Selection.AutoFilter
    Range("A2:S" & UR).Select
    Selection.AutoFilter Field:=18, Criteria1:=">1", Operator:=xlAnd
    Range("N3:S" & UR).Interior.ColorIndex = 6
    ActiveSheet.ShowAllData
    Application.ScreenUpdating = True
End Sub

Sub Copia_e_Imposta_Formati()
    Sheets("Volume affari").Select
    Cells.Delete Shift:=xlUp
    With Cells
        .VerticalAlignment = xlCenter
        .Interior.ColorIndex = xlNone
    End With
   
    Sheets("Provvigioni contabilizzate").Select
    Columns("A:G").Select
    Selection.Copy
    Sheets("Volume affari").Select
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C:C,E:E").Select
    Selection.NumberFormat = "m/d/yyyy"
    Range("A1").Copy
    Range("B1:G1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("A:G").Select
    Columns("A:G").EntireColumn.AutoFit
    Sheets("Provvigioni contabilizzate").Select
    [A2].Select
End Sub

Sub Cancella_Righe()
    Sheets("Volume affari").Select
    UR = Range("N" & Rows.Count).End(xlUp).Row
    Range("N2:S" & UR).Select
    Selection.AutoFilter Field:=1, Criteria1:="<>"
    ActiveSheet.ShowAllData
    Selection.AutoFilter
    Selection.AutoFilter Field:=5, Criteria1:=">1", Operator:=xlAnd
    UR = Range("N" & Rows.Count).End(xlUp).Row
    If UR > 2 Then
        Rows("3:" & UR).Delete Shift:=xlUp
    End If
    ActiveSheet.ShowAllData
    Selection.AutoFilter
    UR = Range("E" & Rows.Count).End(xlUp).Row
    Range("A2:S" & UR).Select
    Selection.Sort Key1:=Range("S3"), Order1:=xlAscending, Key2:=Range("R3") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
'    Range("N2:S" & UR).Clear ' <<===== TOGLI l'apice a questa istruzione dopo le verifiche
    Range("A2").Select
End Sub


[grankio]

ciao, riesco solo ora a darti un file più aggiornato ma non ho avuto tempo per caricare i dati, secondo te è un problema inserire alla fine di ogni estratto conto un totale?

cmq ho provato il tuo foglio con i dati nuovi, ma va a cancellare righe in più ad esempio la 34 c e 2 volte ma la elimina definitivamente, puo essere la riga dei totali?
t allego il file http://www.filedropper.com/fileconpiudati

[grankio]

ciao, sei riuscito a capire se il problema e relativo alla riga del totale che ho inserito?

[ricky53]

Ciao,
SI è proprio la riga TOTALI a creare problemi !!!

Mai inserire una riga di "Totali" tra i dati!!!

I totali si possono ottenere facilmente con una pivot e ... preferibilmente su un altro foglio.