Devo aggiungere che anche lasciando solo le prime dieci righe non colora lo stesso le celle variate .....
problemi di aggiornamento di excel ? o altro .....?
Moderatori: Anthony47, Flash30005
Flash30005 ha scritto:Mi domandavo perché colorare le righe e non lasciare solo le righe interessate? es.
foglio3 solo quelle che erano nel vecchio catalogo e non più nel nuovo
foglio4 solo prodotti che sono stati aggiunti nel nuovo
(queste righe potrebbero tornare utili per ulteriori utilizzi)
allora ho creato una macro che ha questa funzione
- Codice: Seleziona tutto
Sub Confronta()
' Foglio1 Vecchio Catalogo
' Foglio2 Nuovo Catalogo
' Foglio3 Prodotti che non sono più nel nuovo catalogo
' Foglio4 Nuovi prodotti (non erano nel vecchio catalogo)
Call CopiaF
URS = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row '<<<< alias Foglio3
URA = Worksheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row '<<< alias Foglio4
For RS = 2 To URS
For RA = URA To 2 Step -1
If Worksheets("Foglio1").Cells(RS, 1).Value = Worksheets("Foglio4").Cells(RA, 1).Value Then Worksheets("Foglio4").Rows(RA & ":" & RA).Delete
Next RA
Next RS
For RA = 2 To URA
For RS = URS To 2 Step -1
If Worksheets("Foglio2").Cells(RA, 1).Value = Worksheets("Foglio3").Cells(RS, 1).Value Then Worksheets("Foglio3").Rows(RS & ":" & RS).Delete
Next RS
Next RA
End Sub
Sub CopiaF()
Sheets("Foglio3").Select
Cells.Select
Selection.Clear
Range("D10").Select
Sheets("Foglio4").Select
Cells.Select
Selection.Clear
Range("A1").Select
Sheets("Foglio1").Select
Cells.Select
Selection.Copy
Sheets("Foglio3").Select
Cells.Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Foglio2").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Foglio4").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Foglio3").Select
End Sub
Se intendi colorarle allora puoi usare questa macro (la macro CopiaF è sempre necessaria)
- Codice: Seleziona tutto
Sub ConfrontaEColora()
' Foglio1 Vecchio Catalogo
' Foglio2 Nuovo Catalogo
' Foglio3 Prodotti che non sono più nel nuovo catalogo
' Foglio4 Nuovi prodotti (non erano nel vecchio catalogo)
Call CopiaF
URS = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row '<<<< alias Foglio3
UCS = Worksheets("Foglio1").Range("IV2").End(xlToLeft).Column
Worksheets("Foglio3").Select
Worksheets("Foglio3").Range(Cells(2, 1), Cells(URS, UCS)).Interior.ColorIndex = 44
URA = Worksheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row '<<< alias Foglio4
UCA = Worksheets("Foglio2").Range("IV2").End(xlToLeft).Column
Worksheets("Foglio4").Select
Worksheets("Foglio4").Range(Cells(2, 1), Cells(URA, UCA)).Interior.ColorIndex = 6
For RS = 2 To URS
For RA = URA To 2 Step -1
If Worksheets("Foglio1").Cells(RS, 1).Value = Worksheets("Foglio4").Cells(RA, 1).Value Then Worksheets("Foglio4").Rows(RA & ":" & RA).Interior.ColorIndex = 0
Next RA
Next RS
For RA = 2 To URA
For RS = URS To 2 Step -1
If Worksheets("Foglio2").Cells(RA, 1).Value = Worksheets("Foglio3").Cells(RS, 1).Value Then Worksheets("Foglio3").Rows(RS & ":" & RS).Interior.ColorIndex = 0
Next RS
Next RA
End Sub
Ambedue le macro prevedono una testata nella riga 1 che non verrà processata
e fanno il confronto solo prendendo in esame il valore nella colonna A (suppongo Codice Prodotto), oltre a poter variare la colonna di confronto puoi aggiungere ulteriori condizioni (altre colonne) affinché il valore di confronto diventi univoco.
Fai sapere
Ciao
For RA = URA To 2 Step -1
If Worksheets("Foglio1").Cells(RS, 1).Value = Worksheets("Foglio4").Cells(RA, 1).Value Then Worksheets("Foglio4").Rows(RA & ":" & RA).Delete '<<<< questo è il codice ceh effettua il controllo
For RA = URA To 2 Step -1 '<<< ciclo For ... next invariato
Dati1 = Worksheets("Foglio1").Cells(RS, 1).Value & Worksheets("Foglio1").Cells(RS, 2).Value & Worksheets("Foglio1").Cells(RS, 3).Value '<<<< colonna A e B e C etc
Dati4 = Worksheets("Foglio4").Cells(RA, 1).Value & Worksheets("Foglio4").Cells(RA, 2).Value & Worksheets("Foglio4").Cells(RA, 3).Value
If Dati1 = Dati4 Then Worksheets("Foglio4").Rows(RA & ":" & RA).Delete
'...
Flash30005 ha scritto:Nessuno ha detto che le righe si devono trovare nella stessa posizione
fai la tua prova
poi ci risentiamo
ciao
Sub ClearF()
Sheets("Foglio1").Select
Cells.Select
Selection.Clear
Range("A2").Select
Sheets("Foglio2").Select
Cells.Select
Selection.Clear
Range("A2").Select
Sheets("Foglio3").Select
Cells.Select
Selection.Clear
Range("A2").Select
Sheets("Foglio4").Select
Cells.Select
Selection.Clear
Range("A2").Select
Call CopyF1
End Sub
Sub CopyF1()
Range("A1").Select
Sheets("Actual").Select
Cells.Select
Selection.Copy
Sheets("Foglio1").Select
Cells.Select
ActiveSheet.Paste
Range("A1").Select
Sheets("New").Select
Cells.Select
Selection.Copy
Sheets("Foglio2").Select
Cells.Select
ActiveSheet.Paste
Call CopyF
End Sub
Sub CopyF()
Range("A1").Select
Sheets("Foglio1").Select
Cells.Select
Selection.Copy
Sheets("Foglio3").Select
Cells.Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Foglio2").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Foglio4").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Foglio3").Select
End Sub
Sub ConfrontaEColora()
' Foglio1 Copia del Foglio Actual filtrato
' Foglio2 Copia del Foglio New filtrato
' Foglio3 Copia del Foglio 1 con Check da Actual a New Report su Actual
' Foglio4 Copia del Foglio 2 con Check da New a Actual Report su New
Application.ScreenUpdating = False
Application.Calculation = xlManual
Call ClearF
Righe1 = Worksheets("Foglio3").Cells(Rows.Count, 2).End(xlUp).Row
Righe2 = Worksheets("Foglio4").Cells(Rows.Count, 2).End(xlUp).Row
Mt = Mt & "HAI SCELTO DI LANCIARE QUESTA MACRO" & Chr(10)
Mt = Mt & "SEI SICURO DI VOLERLO FARE ????" & Chr(10) & Chr(10)
Mt = Mt & "LA VERIFICA SARA' FATTA SU:" & Chr(10) & Chr(10)
Mt = Mt & (Righe1) & " RIGHE" & " (DA ACTUAL)" & Chr(10)
Mt = Mt & (Righe2) & " RIGHE" & " (DA NEW)" & Chr(10) & Chr(10)
rs = MsgBox(prompt:=Mt, Title:="CHECK REPORT", Buttons:=vbYesNo + vbQuestion)
If rs = vbNo Then Exit Sub
URS = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row '<<<< alias Foglio3
UCS = Worksheets("Foglio1").Range("IV2").End(xlToLeft).Column
Worksheets("Foglio3").Select
Worksheets("Foglio3").Range(Cells(2, 1), Cells(URS, UCS)).Interior.ColorIndex = 3
URA = Worksheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row '<<< alias Foglio4
UCA = Worksheets("Foglio2").Range("IV2").End(xlToLeft).Column
Worksheets("Foglio4").Select
Worksheets("Foglio4").Range(Cells(2, 1), Cells(URA, UCA)).Interior.ColorIndex = 4
For rs = 2 To URS
For RA = URA To 2 Step -1
For CS = 1 To UCA
Name1 = Worksheets("Foglio1").Cells(rs, 1).Value & Worksheets("Foglio1").Cells(rs, 2).Value '<<<< colonne A e B
Rev1 = Worksheets("Foglio1").Cells(rs, 5).Value '<<<< colonna E
Name4 = Worksheets("Foglio4").Cells(RA, 1).Value & Worksheets("Foglio4").Cells(RA, 2).Value '<<<< colonne A e B
Rev4 = Worksheets("Foglio4").Cells(RA, 5).Value '<<<< colonna E
If Name1 = Name4 And Rev1 < Rev4 Then Worksheets("Foglio4").Cells(RA, CS).Interior.ColorIndex = 6
If Name1 = Name4 And Rev1 = Rev4 Then Worksheets("Foglio4").Cells(RA, CS).Interior.ColorIndex = 0
Next CS
Next RA
Next rs
For RA = 2 To URA
For rs = URS To 2 Step -1
For CS = 1 To UCA
Name2 = Worksheets("Foglio2").Cells(RA, 1).Value & Worksheets("Foglio2").Cells(RA, 2).Value '<<<< colonne A e B
Rev2 = Worksheets("Foglio2").Cells(RA, 5).Value '<<<< colonna E
Name3 = Worksheets("Foglio3").Cells(rs, 1).Value & Worksheets("Foglio3").Cells(rs, 2).Value '<<<< colonne A e B
Rev3 = Worksheets("Foglio3").Cells(rs, 5).Value '<<<< colonna E
If Name2 = Name3 And Rev2 > Rev3 Then Worksheets("Foglio3").Cells(RA, CS).Interior.ColorIndex = 44
If Name2 = Name3 And Rev2 = Rev3 Then Worksheets("Foglio3").Cells(RA, CS).Interior.ColorIndex = 0
Next CS
Next rs
Next RA
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub ConfrontaEColora()
' Foglio1 Copia del Foglio Actual filtrato
' Foglio2 Copia del Foglio New filtrato
' Foglio3 Copia del Foglio 1 con Check da Actual a New Report su Actual
' Foglio4 Copia del Foglio 2 con Check da New a Actual Report su New
Application.ScreenUpdating = False
Application.Calculation = xlManual
Call ClearF
Righe1 = Worksheets("Foglio3").Cells(Rows.Count, 2).End(xlUp).Row
Righe2 = Worksheets("Foglio4").Cells(Rows.Count, 2).End(xlUp).Row
Mt = ""
Mt = Mt & "HAI SCELTO DI LANCIARE QUESTA MACRO" & Chr(10)
Mt = Mt & "SEI SICURO DI VOLERLO FARE ????" & Chr(10) & Chr(10)
Mt = Mt & "LA VERIFICA SARA' FATTA SU:" & Chr(10) & Chr(10)
Mt = Mt & (Righe1) & " RIGHE" & " (DA ACTUAL)" & Chr(10)
Mt = Mt & (Righe2) & " RIGHE" & " (DA NEW)" & Chr(10) & Chr(10)
RS = MsgBox(prompt:=Mt, Title:="CHECK REPORT", Buttons:=vbYesNo + vbQuestion)
If RS = vbNo Then Exit Sub
URS = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row '<<<< alias Foglio3
UCS = Worksheets("Foglio1").Range("IV2").End(xlToLeft).Column
Worksheets("Foglio3").Select
Worksheets("Foglio3").Range(Cells(2, 1), Cells(URS, UCS)).Interior.ColorIndex = 3
URA = Worksheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row '<<< alias Foglio4
UCA = Worksheets("Foglio2").Range("IV2").End(xlToLeft).Column
Worksheets("Foglio4").Select
Worksheets("Foglio4").Range(Cells(2, 1), Cells(URA, UCA)).Interior.ColorIndex = 4
For RS = 2 To URS
Min = 0
Ugu = 0
Name1 = Worksheets("Foglio1").Cells(RS, 1).Value & Worksheets("Foglio1").Cells(RS, 2).Value '<<<< colonne A e B
Rev1 = Val(Worksheets("Foglio1").Cells(RS, 5)) '<<<< colonna E
For RA = 2 To URA
'For CS = 1 To UCA
Name4 = Worksheets("Foglio4").Cells(RA, 1).Value & Worksheets("Foglio4").Cells(RA, 2).Value '<<<< colonne A e B
Rev4 = Val(Worksheets("Foglio4").Cells(RA, 5)) '<<<< colonna E
If Name1 = Name4 And Rev1 < Rev4 Then
Min = 1
GoTo SaltaRS
End If
If Name1 = Name4 And Rev1 = Rev4 Then
Ugu = 1
GoTo SaltaRS
End If
' Next CS
Next RA
SaltaRS:
If Min = 1 Then
Worksheets("Foglio4").Select
Worksheets("Foglio4").Range(Cells(RA, 1), Cells(RA, UCA)).Interior.ColorIndex = 6
Worksheets("Foglio3").Select
Worksheets("Foglio3").Range(Cells(RS, 1), Cells(RS, UCA)).Interior.ColorIndex = 44
End If
If Ugu = 1 Then
Worksheets("Foglio4").Select
Worksheets("Foglio4").Range(Cells(RA, 1), Cells(RA, UCA)).Interior.ColorIndex = xlNone
Worksheets("Foglio3").Select
Worksheets("Foglio3").Range(Cells(RS, 1), Cells(RS, UCA)).Interior.ColorIndex = xlNone
End If
Next RS
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub CopiaF()
Sheets("Foglio3").Select
Cells.Select
Selection.Clear
Range("D10").Select
Sheets("Foglio4").Select
Cells.Select
Selection.Clear
Range("A1").Select
Sheets("Foglio1").Select
Cells.Select
Selection.Copy
Sheets("Foglio3").Select
Cells.Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Foglio2").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Foglio4").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Foglio3").Select
End Sub
Sub ConfrontaEColora()
' Foglio1 Elenco Utenti Infrataras
' Foglio2 Elenco Utenti Enel gas
' Foglio3 Utenti che non sono più nel Elenco Utenti Enel gas
' Foglio4 Nuovi Utenti (non erano nel Elenco Utenti Infrataras)
Call CopiaF
URS = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row '<<<< alias Foglio3
UCS = Worksheets("Foglio1").Range("IV2").End(xlToLeft).Column
Worksheets("Foglio3").Select
Worksheets("Foglio3").Range(Cells(2, 1), Cells(URS, UCS)).Interior.ColorIndex = 44
URA = Worksheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row '<<< alias Foglio4
UCA = Worksheets("Foglio2").Range("IV2").End(xlToLeft).Column
Worksheets("Foglio4").Select
Worksheets("Foglio4").Range(Cells(2, 1), Cells(URA, UCA)).Interior.ColorIndex = 6
For RS = 2 To URS
For RA = URA To 2 Step -1
For CS = 1 To UCA
If Worksheets("Foglio1").Cells(RS, CS).Value = Worksheets("Foglio4").Cells(RA, CS).Value Then Worksheets("Foglio4").Cells(RA, CS).Interior.ColorIndex = 0
Next CS
Next RA
Next RS
For RA = 2 To URA
For RS = URS To 2 Step -1
For CS = 1 To UCA
If Worksheets("Foglio2").Cells(RA, CS).Value = Worksheets("Foglio3").Cells(RS, CS).Value Then Worksheets("Foglio3").Cells(RA, CS).Interior.ColorIndex = 0
Next CS
Next RS
Next RA
End Sub
Sub ConfrontaEColora()
Set Ws1 = Worksheets("Foglio1") 'Elenco Utenti Infrataras
Set Ws2 = Worksheets("Foglio2") 'Elenco Utenti Enel gas
Set Ws3 = Worksheets("Foglio3") 'Utenti che non sono più nel Elenco Utenti Enel gas
Set Ws4 = Worksheets("Foglio4") 'Nuovi Utenti (non erano nel Elenco Utenti Infrataras)
Ws3.Cells.Clear
Ws4.Cells.Clear
Ws1.Cells.Copy Destination:=Ws3.Cells
Ws2.Cells.Copy Destination:=Ws4.Cells
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row '<<<< alias Foglio3
UCS = Ws1.Range("IV1").End(xlToLeft).Column
Ws3.Select
Ws3.Range(Cells(2, 1), Cells(URS, UCS)).Interior.ColorIndex = 44
URA = Ws2.Range("A" & Rows.Count).End(xlUp).Row '<<< alias Foglio4
Set Ws4 = Ws4
Ws4.Select
UCA = Ws2.Range("IV1").End(xlToLeft).Column
Ws4.Range(Ws4.Cells(2, 1), Ws4.Cells(URA, UCA)).Interior.ColorIndex = 6
For RS = 2 To URS
StrRS = ""
UCA = Ws1.Range("IV" & RS).End(xlToLeft).Column
For CS = 1 To UCA
StrRS = StrRS & Ws1.Cells(RS, CS).Value
Next CS
For RA = 2 To URA
StrRA = ""
For CS = 1 To UCA
StrRA = StrRA & Ws4.Cells(RA, CS).Value
Next CS
If StrRS = StrRA Then
Ws4.Range(Ws4.Cells(RA, 1), Ws4.Cells(RA, 7)).Interior.ColorIndex = 0
End If
Next RA
Next RS
For RA = 2 To URA
StrRA = ""
UCA = Ws2.Range("IV" & RA).End(xlToLeft).Column
For CS = 1 To UCA
StrRA = StrRA & Ws2.Cells(RA, CS).Value
Next CS
For RS = 2 To URS
StrRS = ""
For CS = 1 To UCA
StrRS = StrRS & Ws3.Cells(RS, CS).Value
Next CS
If StrRS = StrRA Then
Ws3.Range(Ws3.Cells(RS, 1), Ws3.Cells(RS, 7)).Interior.ColorIndex = 0
End If
Next RS
Next RA
End Sub
Torna a Applicazioni Office Windows
Macro che scatta quando cambia dato in un altro file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 14 |
Excel: formula automatica per evidenziare prodotto scaduto Autore: gamma_ray |
Forum: Applicazioni Office Windows Risposte: 3 |
Salvare file excel in formato html escludendo le immagini Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 10 |
Modifica visualizzazione file di una cartella Autore: mastino46 |
Forum: Sistemi Operativi Windows Risposte: 2 |
Problema con macro copia e rinomina file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 75 ospiti