Moderatori: Anthony47, Flash30005
Option Explicit
Option Base 1
Option Compare Text
Private I As Long, J As Long, K As Integer, X As Integer, UR1 As Long, UC1 As Integer, UC2 As Integer, UR2 As Long
Private WsIn1 As Worksheet, WsIn2 As Worksheet, WsOut As Worksheet
Private RangeIn1 As Range, RangeIn2 As Range, RangeOut As Range
Private MatriceIn1(), MatriceIn2(), MatriceOut()
Sub Copia_Articoli_da_più_Fogli()
Dim Inizio As Double
Dim Fine As Double
Inizio = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set WsIn1 = Sheets("Listino")
Set WsIn2 = Sheets("Offerte")
Set WsOut = Sheets("Finale")
UR1 = WsOut.Range("A" & Rows.Count).End(xlUp).Row
If UR1 >= 2 Then
WsOut.Range("A2:F" & UR1).ClearContents
End If
UC1 = WsIn1.Range("A2").End(xlToRight).Column
UC2 = WsIn2.Range("A2").End(xlToRight).Column
UR1 = WsIn1.Range("A" & Rows.Count).End(xlUp).Row
Set RangeIn1 = WsIn1.Range(WsIn1.Cells(2, 1), WsIn1.Cells(UR1, UC1))
MatriceIn1 = RangeIn1
UR2 = WsIn2.Range("A" & Rows.Count).End(xlUp).Row
Set RangeIn2 = WsIn2.Range(WsIn2.Cells(2, 1), WsIn2.Cells(UR2 + 1, UC2))
MatriceIn2 = RangeIn2
ReDim MatriceOut(UR1 + UR2, UC2)
K = 0
J = 1
For I = 1 To UR1 - 1
Continua:
K = K + 1
If MatriceIn1(I, 1) > MatriceIn2(J, 1) And MatriceIn2(J, 1) <> "" Then
' Articolo di "2" non presente su "1"
Scrivi_Dati_Maggiori
J = J + 1
GoTo Continua
Else
If MatriceIn1(I, 1) = MatriceIn2(J, 1) Then
Scrivi_Dati_Uguali
J = J + 1
Else
' Articolo di "1" non presente su "2"
Scrivi_Dati_Minori
End If
End If
Next I
If MatriceIn1(UR1 - 1, 1) < MatriceIn2(J, 1) Then
' Restanti Articoli di "2" non presenti su "1"
Scrivi_Restanti_di_2
End If
Set RangeOut = WsOut.Range(WsOut.Cells(2, 1), WsOut.Cells(UR1 + UR2, UC2))
RangeOut = MatriceOut
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Fine = Timer
MsgBox "Elaborazione Terminata. Tempo impegato per l'elaborazione: " & Round(Fine - Inizio, 3)
End Sub
Sub Scrivi_Dati_Maggiori()
' Articolo di "2" non presente su "1"
For X = 1 To UC2
MatriceOut(K, X) = MatriceIn2(J, X)
Next X
End Sub
Sub Scrivi_Dati_Uguali()
For X = 1 To UC1
MatriceOut(K, X) = MatriceIn1(I, X)
Next X
End Sub
Sub Scrivi_Dati_Minori()
' Articolo di "1" non presente su "2"
For X = 1 To UC1
MatriceOut(K, X) = MatriceIn1(I, X)
Next X
End Sub
Sub Scrivi_Restanti_di_2()
' Ulteriori Articoli di "2" non presenti su "1"
Do While J < UR2
Scrivi_Dati_Maggiori
J = J + 1
K = K + 1
Loop
End Sub
Vorrei ottenere su un foglio tutti i record contenuti in LISTINO (anche solo fino alla colonna "V" con 2 colonne aggiuntive (W e X) in cui dovrebbero essere contenuti i valori SCONTO e MESE OFFERTA presi dalla pagina PROMO.
Riguardo invece ai record presenti in PROMO e non in LISTINI la cosa migliore sarebbe che fossero SCARTATI (magari scritti in una pagina dal nome SCARTATI) oppure anche inclusi sulla pagina FINALE ma con tutti (tanti) i campi VUOTI, in modo che possa rintracciarli.
Altro anomalia possibile è che le descrizioni non siano ide
ntiche per stesso cod.articolo: in questo caso direi andrebbe bene sia usare quella di LISTINO che scrivere sulla pagina FINALE i 2 record.
ricky53 ha scritto:Cio Leo,
alcune domande e considerazioni:Vorrei ottenere su un foglio tutti i record contenuti in LISTINO (anche solo fino alla colonna "V" con 2 colonne aggiuntive (W e X) in cui dovrebbero essere contenuti i valori SCONTO e MESE OFFERTA presi dalla pagina PROMO.
1. da "Listino" copiamo in "Finale" solo le colonne "A:V". A te va bene?
2. Oppure copiamo tuttel el colonne di "Listino" e sostituiamo le colonne "V:W" con le colonne del punto successivo ?
3. Quali sono le colonne di "PROMO" da prendere e copiare in "Finale" ?
Riguardo invece ai record presenti in PROMO e non in LISTINI la cosa migliore sarebbe che fossero SCARTATI (magari scritti in una pagina dal nome SCARTATI) oppure anche inclusi sulla pagina FINALE ma con tutti (tanti) i campi VUOTI, in modo che possa rintracciarli.
Propongo di scrivere i dati presenti in "Promo" e non presenti in "Listino" in un nuovo foglio "Scartati". a te va bene ?
Altro anomalia possibile è che le descrizioni non siano ide
ntiche per stesso cod.articolo: in questo caso direi andrebbe bene sia usare quella di LISTINO che scrivere sulla pagina FINALE i 2 record.
Propongo di copiare i dati da "Listino". A te va bene?
Attendo le tue risposte prima di modificare il codice che ti ho proposto in un mio precedente intervento.
Infine sarebbe perfetto cancellare i record che non hanno nulla sulla colonne T (quelli con "-" o "nulla" sulla colonna EAN) e magari aggiungere anche questi in SCARTATI anche mescolati agli altri.
ricky53 ha scritto:Ciao,
adesso ci siamo e mi è chiaro come operare.
Schematizzando si arriva sempre al risultato !!!Infine sarebbe perfetto cancellare i record che non hanno nulla sulla colonne T (quelli con "-" o "nulla" sulla colonna EAN) e magari aggiungere anche questi in SCARTATI anche mescolati agli altri.
Bene. Si può fare facilmente.
Propongo, crepi l'avarizia, di creare un altro foglio con il nome "Cancellati da Listino" e copiare tutte le righe di "Listino" la cui colonna "T" rispetta le condizioni che hai scritto.
Problema (ma risolvibile) le colonne "Codice Articolo" dei due file non sono fra di loro omogenee e confrontabili direttamente perchè i dati hanno lunghezza diversa (causa presenza di zeri davanti al codice articolo).
Tu confermi che i codici sono tutti "numeri" ?
Se la risposta è "SI" si risolve facilmente (con una semplice controllo nel codice) altrimenti occorre provvedere in un altro modo ma si troverà, comunque, la soluzione.
Option Explicit
Option Base 1
Option Compare Text
Private I As Long, J As Long, K As Integer, L As Integer, X As Integer, UR1 As Long, UC1 As Integer, UC2 As Integer, UR2 As Long
Private WsIn1 As Worksheet, WsIn2 As Worksheet, WsOut As Worksheet, WsSca As Worksheet
Private RangeIn1 As Range, RangeIn2 As Range, RangeOut As Range, RangeSca As Range
Private MatriceIn1(), MatriceIn2(), MatriceOut(), MatriceSca()
Sub Copia_Articoli_da_più_Fogli()
Dim Inizio As Double
Dim Fine As Double
Inizio = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set WsIn1 = Sheets("Listino")
Set WsIn2 = Sheets("Offerte")
Set WsOut = Sheets("Finale")
Set WsSca = Sheets("Scartati")
UR1 = WsOut.Range("A" & Rows.Count).End(xlUp).Row
UR2 = WsSca.Range("A" & Rows.Count).End(xlUp).Row
' UC1 = WsIn1.Range("A1").End(xlToRight).Column ' <<------- se si vogliono avere tutte le colonne
UC1 = 22 ' <<------- se si vogliono avere le colonne fino alla "V"
UC2 = WsIn2.Range("A1").End(xlToRight).Column
If UR1 >= 2 Then
WsOut.Range(WsOut.Cells(2, 1), WsOut.Cells(UR1, UC1)).ClearContents
End If
If UR2 >= 2 Then
WsSca.Range("A2", WsSca.Cells(UR2, UC1)).ClearContents
End If
UR1 = WsIn1.Range("A" & Rows.Count).End(xlUp).Row
'-------------------------------
Cancella_Dati_Colonna_T
'-------------------------------
UR1 = WsIn1.Range("A" & Rows.Count).End(xlUp).Row
Set RangeIn1 = WsIn1.Range(WsIn1.Cells(2, 1), WsIn1.Cells(UR1, UC1))
' Ordinamento per "Codice Articolo" Crescente
RangeIn1.Sort Key1:=WsIn1.Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
MatriceIn1 = RangeIn1
UR2 = WsIn2.Range("A" & Rows.Count).End(xlUp).Row
Set RangeIn2 = WsIn2.Range(WsIn2.Cells(2, 1), WsIn2.Cells(UR2 + 1, UC2))
' Ordinamento per "Codice Articolo" Crescente
RangeIn2.Sort Key1:=WsIn2.Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
MatriceIn2 = RangeIn2
' Aggiunte "4" colonne di "Offerte"
ReDim MatriceOut(UR1 + UR2, UC1 + 4)
ReDim MatriceSca(UR2, UC2)
WsIn1.Range("A1:V1").Copy
WsOut.Range("A1").PasteSpecial xlPasteValues
WsOut.Range("W1") = WsIn2.Range("E1")
WsOut.Range("X1") = WsIn2.Range("K1")
WsOut.Range("Y1") = WsIn2.Range("L1")
WsOut.Range("Z1") = WsIn2.Range("M1")
WsIn2.Range("A1:O1").Copy
WsSca.Range("A1").PasteSpecial xlPasteValues
K = 0: L = 0
J = 1
For I = 1 To UR1 - 1
Continua:
If Val(MatriceIn1(I, 1)) > Val(MatriceIn2(J, 1)) And MatriceIn2(J, 1) <> "" Then
' Articolo di "2" non presente su "1"
Scrivi_Dati_Maggiori
J = J + 1
GoTo Continua
Else
If Val(MatriceIn1(I, 1)) = Val(MatriceIn2(J, 1)) Then
Scrivi_Dati_Uguali
J = J + 1
Else
' Articolo di "1" non presente su "2"
Scrivi_Dati_Minori
End If
End If
Next I
If Val(MatriceIn1(UR1 - 1, 1)) < Val(MatriceIn2(J, 1)) Then
' Restanti Articoli di "2" non presenti su "1"
Scrivi_Restanti_di_2
End If
Set RangeOut = WsOut.Range(WsOut.Cells(2, 1), WsOut.Cells(UBound(MatriceOut), UC1 + 4))
' La colonna "V" ("22") contiene più di 225 caratteri, vanno eliminati quelli oltre i 255
J = 22
For I = 1 To UBound(MatriceOut)
If Len(MatriceOut(I, 22)) > 255 Then
MatriceOut(I, 22) = Left(MatriceOut(I, 22), 255)
End If
Next I
RangeOut = MatriceOut
WsOut.Select
Columns("T:T").NumberFormat = "0"
Columns("V:V").WrapText = True
Columns("V:V").ColumnWidth = 50
Cells.EntireRow.AutoFit
Cells.VerticalAlignment = xlCenter
Set RangeSca = WsSca.Range(WsSca.Cells(2, 1), WsSca.Cells(UBound(MatriceSca), UC2))
RangeSca = MatriceSca
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Fine = Timer
MsgBox "Elaborazione Terminata. Tempo impegato per l'elaborazione: " & Round(Fine - Inizio, 3)
End Sub
Sub Scrivi_Dati_Maggiori()
' Articolo di "2" non presente su "1"
L = L + 1
For X = 1 To UC2
MatriceSca(L, X) = MatriceIn2(J, X)
Next X
End Sub
Sub Scrivi_Dati_Uguali()
K = K + 1
For X = 1 To UC1
MatriceOut(K, X) = MatriceIn1(I, X)
Next X
MatriceOut(K, UC1 + 1) = MatriceIn2(J, 5)
MatriceOut(K, UC1 + 2) = MatriceIn2(J, 11)
MatriceOut(K, UC1 + 3) = MatriceIn2(J, 12)
MatriceOut(K, UC1 + 4) = MatriceIn2(J, 13)
End Sub
Sub Scrivi_Dati_Minori()
' Articolo di "1" non presente su "2"
K = K + 1
For X = 1 To UC1
MatriceOut(K, X) = MatriceIn1(I, X)
Next X
End Sub
Sub Scrivi_Restanti_di_2()
' Ulteriori Articoli di "2" non presenti su "1"
Do While J < UR2
Scrivi_Dati_Maggiori
J = J + 1
Loop
End Sub
Sub Cancella_Dati_Colonna_T()
Sheets("Cancellati da Listino").Select
Cells.Clear
WsIn1.Rows("1:1").Copy
Rows("1:1").Select
ActiveSheet.Paste
WsIn1.Select
Selection.AutoFilter Field:=1, Criteria1:="<>"
WsIn1.ShowAllData
Selection.AutoFilter Field:=20, Criteria1:="-"
WsIn1.Range(WsIn1.Cells(2, 1), WsIn1.Cells(UR1, UC1)).Copy ' Cut
Sheets("Cancellati da Listino").Select
Range("A2").Select
ActiveSheet.Paste
Cells.WrapText = False
WsIn1.Select
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
[A1].Select
End Sub
UC2 = WsIn2.Range("A1").End(xlToRight).Column
UC2 = 15
Torna a Applicazioni Office Windows
Inserire dati filtrati da 2 file ad un terzo file Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 14 |
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Excel: problema con date se devo unirle a testi Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 5 |
Visitano il forum: Nessuno e 21 ospiti