Ciao,
oggi è una "giornata uggiosa" e, quindi, ho avuto modo di dedicarmi un po' al forum ... ho scelto di fare tutto tramite macro.
PREMESSA: LEGGI CON MOLTA ATTENZIONE QUANTO SEGUEAllora:
0. Fai una copia del tuo file
1. NON APRIRE il file ORIGINALE !!! Lavora sulla copia
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 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()
Sheets("Provvigioni contabilizzate").Select
Application.ScreenUpdating = False
UR = Range("Q" & Rows.Count).End(xlUp).Row
Range("A2:S" & UR).Select
Selection.AutoFilter Field:=1, 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("B" & 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:=xlGuess, 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
'..................................................................................................
' Call Cancella_Righe ' <<====== QUESTA MACRO va eseguita solo dopo aver fatto le verifiche
'..................................................................................................
Application.ScreenUpdating = True
MsgBox "Elaborazione Effettuata"
End Sub
Sub Cancella_Righe()
Sheets("Provvigioni contabilizzate").Select
UR = Range("B" & Rows.Count).End(xlUp).Row
Range("A2:S" & UR).Select
Selection.AutoFilter Field:=1, Criteria1:="<>"
ActiveSheet.ShowAllData
Selection.AutoFilter Field:=18, Criteria1:=">1", Operator:=xlAnd
UR = Range("B" & Rows.Count).End(xlUp).Row
Rows("3:" & UR).Select
Rows("3:" & UR).Delete Shift:=xlUp
ActiveSheet.ShowAllData
UR = Range("B" & Rows.Count).End(xlUp).Row
Range("A2:S" & UR).Select
Selection.Sort Key1:=Range("S3"), Order1:=xlAscending, Key2:=Range("R3") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
End Sub