Diciamo che la macro fa oltre quello di cui io ho bisogno.
Il foglio tre in realtà potrebbe non servirmi, mi bastano i risultati visibili al foglio 4.
Dici che modificando la macro in tal senso abbiamo prestazioni migliori ?
Moderatori: Anthony47, Flash30005
Sub CopiaF()
Sheets("Foglio4").Select
Cells.Select
Selection.Clear
Range("A1").Select
Sheets("Foglio2").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Foglio4").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
End Sub
Sub ConfrontaEColora()
Application.ScreenUpdating = False
Application.Calculation = xlManual
' Foglio1 Vecchio Catalogo
' Foglio2 Nuovo Catalogo
' Foglio4 Nuovi prodotti (non erano nel vecchio catalogo)
Call CopiaF
URS = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row
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 = xlNone
Next CS
Next RA
Next RS
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Confronta()
NF = 2
For F = 1 To NF
URS = Worksheets("Foglio" & F).Range("A" & Rows.Count).End(xlUp).Row
i = 2
For RS = 2 To URS
Cod1S = Worksheets("Foglio" & F).Cells(RS, 1).Value
For RS2 = 2 To i
Cod2s = Worksheets("Foglio" & F).Cells(RS2, 10).Value
If Cod1S = Cod2s Then GoTo esci
Next RS2
Worksheets("Foglio" & F).Cells(i, 10).Value = Cod1S
i = i + 1
esci:
Next RS
URE = Worksheets("Foglio" & F).Range("J" & Rows.Count).End(xlUp).Row
For RV = 2 To URE
Cod1A = Worksheets("Foglio" & F).Cells(RV, 10).Value
For RS = 2 To URS
Cod1S = Worksheets("Foglio" & F).Cells(RS, 1).Value
If Cod1A = Cod1S Then Worksheets("Foglio" & F).Cells(RV, 11).Value = Worksheets("Foglio" & F).Cells(RV, 11).Value + Worksheets("Foglio" & F).Cells(RS, 2).Value
Next RS
Next RV
Next F
Call compila3e4
End Sub
Sub compila3e4()
UR1 = Worksheets("Foglio1").Range("J" & Rows.Count).End(xlUp).Row
UR2 = Worksheets("Foglio2").Range("J" & Rows.Count).End(xlUp).Row
i = 2
For RC1 = 2 To UR1
Cod1 = Worksheets("Foglio1").Range("J" & RC1).Value
Val1 = Worksheets("Foglio1").Range("K" & RC1).Value
For RC2 = 2 To UR2
Cod2 = Worksheets("Foglio2").Range("J" & RC2).Value
If Cod1 <> Cod2 Then GoTo esci
Val2 = Worksheets("Foglio2").Range("K" & RC2).Value
If Val1 = Val2 Then GoTo esci
Worksheets("Foglio1").Range("J" & RC1 & ":K" & RC1).Copy Destination:=Worksheets("Foglio3").Range("A" & i & ":B" & i)
Worksheets("Foglio2").Range("J" & RC2 & ":K" & RC2).Copy Destination:=Worksheets("Foglio4").Range("A" & i & ":B" & i)
i = i + 1
esci:
Next RC2
Next RC1
Worksheets("Foglio1").Range("A1:B1").Copy Destination:=Worksheets("Foglio3").Range("A1:B1")
Worksheets("Foglio2").Range("A1:B1").Copy Destination:=Worksheets("Foglio4").Range("A1:B1")
Sheets("Foglio1").Select
Columns("J:K").ClearContents
Range("A1").Select
Sheets("Foglio2").Select
Columns("J:K").ClearContents
Range("A1").Select
Sheets("Foglio4").Select
End Sub
Flash30005 ha scritto:Oppure...
se vuoi utilizzare delle macro, puoi usare questo codice
- Codice: Seleziona tutto
Sub Confronta()
NF = 2
For F = 1 To NF
URS = Worksheets("Foglio" & F).Range("A" & Rows.Count).End(xlUp).Row
i = 2
For RS = 2 To URS
Cod1S = Worksheets("Foglio" & F).Cells(RS, 1).Value
For RS2 = 2 To i
Cod2s = Worksheets("Foglio" & F).Cells(RS2, 10).Value
If Cod1S = Cod2s Then GoTo esci
Next RS2
Worksheets("Foglio" & F).Cells(i, 10).Value = Cod1S
i = i + 1
esci:
Next RS
URE = Worksheets("Foglio" & F).Range("J" & Rows.Count).End(xlUp).Row
For RV = 2 To URE
Cod1A = Worksheets("Foglio" & F).Cells(RV, 10).Value
For RS = 2 To URS
Cod1S = Worksheets("Foglio" & F).Cells(RS, 1).Value
If Cod1A = Cod1S Then Worksheets("Foglio" & F).Cells(RV, 11).Value = Worksheets("Foglio" & F).Cells(RV, 11).Value + Worksheets("Foglio" & F).Cells(RS, 2).Value
Next RS
Next RV
Next F
Call compila3e4
End Sub
Sub compila3e4()
UR1 = Worksheets("Foglio1").Range("J" & Rows.Count).End(xlUp).Row
UR2 = Worksheets("Foglio2").Range("J" & Rows.Count).End(xlUp).Row
i = 2
For RC1 = 2 To UR1
Cod1 = Worksheets("Foglio1").Range("J" & RC1).Value
Val1 = Worksheets("Foglio1").Range("K" & RC1).Value
For RC2 = 2 To UR2
Cod2 = Worksheets("Foglio2").Range("J" & RC2).Value
If Cod1 <> Cod2 Then GoTo esci
Val2 = Worksheets("Foglio2").Range("K" & RC2).Value
If Val1 = Val2 Then GoTo esci
Worksheets("Foglio1").Range("J" & RC1 & ":K" & RC1).Copy Destination:=Worksheets("Foglio3").Range("A" & i & ":B" & i)
Worksheets("Foglio2").Range("J" & RC2 & ":K" & RC2).Copy Destination:=Worksheets("Foglio4").Range("A" & i & ":B" & i)
i = i + 1
esci:
Next RC2
Next RC1
Worksheets("Foglio1").Range("A1:B1").Copy Destination:=Worksheets("Foglio3").Range("A1:B1")
Worksheets("Foglio2").Range("A1:B1").Copy Destination:=Worksheets("Foglio4").Range("A1:B1")
Sheets("Foglio1").Select
Columns("J:K").ClearContents
Range("A1").Select
Sheets("Foglio2").Select
Columns("J:K").ClearContents
Range("A1").Select
Sheets("Foglio4").Select
End Sub
I fogli dovranno essere denominati Foglio1, Foglio2, Foglio3 e Foglio4
Nel mio esempio utilizzo momentaneamente le colonne J e K dei fogli 1 e 2 quindi non dovranno preesistere dei dati perché verranno cancellati (si può modificare la macro per utilizzare colonne vuote).
Copia l'intero codice inserendolo in un modulo
avvia la macro "Confronta"
Ciao
Sub Converti()
UR1a = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row
UR2a = Worksheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row
For CN1 = 2 To UR1a
Worksheets("Foglio1").Range("A" & CN1).Value = Val(Worksheets("Foglio1").Range("A" & CN1).Value)
Next CN1
For CN2 = 2 To UR2a
Worksheets("Foglio2").Range("A" & CN2).Value = Val(Worksheets("Foglio2").Range("A" & CN2).Value)
Next CN2
End Sub
Sub Confronta() '<<<<< nome macro esistente
Call Converti '<<<<< Riga chiamata da aggiungere qui
NF = 2 '<<<<< riga esistente esistente
For F = 1 To NF '<<<<< riga esistente
...
...
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 81 ospiti