nik66023 ha scritto:Abbiate pazienza.....
Ne abbiamo da vendere
Nel frattempo vedo che hai già avuto una risposta, comunque
Mi riferisco al tuo primo post
Foglio1 con dati (da aggiornare)
Foglio2 con dati vecchi e nuovi
Vuoi ottenere nel Foglio1 anche i dati "nuovi" del Foglio2 e i codici senza ripetizione e in ordine alfabetico
penso che questa macro risolva il tuo problema in quanto esegue le seguenti operazioni:
1) ordina il foglio1
2) ordina il foglio2
3) toglie i doppioni al foglio2
4) controlla l'esistenza di ogni codice del foglio2, nel foglio1
5) se non esiste accoda alla lista del foglio1
6) ordina di nuovo il foglio1
- Codice: Seleziona tutto
Sub Aggiorna()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Worksheets("Foglio1").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
UR1 = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Foglio2").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
UR2 = Worksheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row
For RR2 = 1 To UR2 - 1
V21 = Trim(Sheets("Foglio2").Range("A" & RR2).Value)
If V21 = "" Then GoTo salta
For RRF2 = UR2 To RR2 + 1 Step -1
V22 = Trim(Sheets("Foglio2").Range("A" & RRF2).Value)
If V22 = V21 Then Sheets("Foglio2").Rows(RRF2 & ":" & RRF2).Delete Shift:=xlUp
Next RRF2
Next RR2
salta:
UR2 = Worksheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row
For RR2 = 1 To UR2
trovato = 0
V2 = Trim(Sheets("Foglio2").Range("A" & RR2).Value)
For RR1 = 1 To UR1
V1 = Trim(Sheets("Foglio1").Range("A" & RR1).Value)
Sheets("Foglio1").Range("A" & RR1).Value = V1
If V2 = V1 Then trovato = 1
Next RR1
If trovato = 0 Then Sheets("Foglio2").Range("A" & RR2).Copy Destination:=Sheets("Foglio1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Next RR2
Worksheets("Foglio1").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
se hai problemi scarica
questo fileFai sapere
Ciao
P.s. Fai attenzione nel foglio2 ci sono due codici identici "F3268J" riga 304 e 305;
la macro corregge anche questo errore ma secondo me, nei nuovi dati (Foglio2), non dovrebbero verificarsi questi inconvenienti.