Filtering e Valori Righe

Timer86

il 10 giu 2020, 14:06

7 risposte

Timer86

Utente Attivo

Iscritto da: giu, 2019

Messaggi:: 69

Filtering e Valori Righe

10 giu 2020, 14:49

Ciao a tutti,

sto creando una piccola automazione che preleva dati da diverse risorse, e gli importa in un singolo xlsm

una volta importati, esempio
Work Order No. Work Order ID Order Status Type Order SKU / Item SKU/Item Description Units - Requested
5230 10297 New FLASH ASTA-4 IMPLANT ANATOMIC 320 CC - S 2
5230 10297 New FLASH ASTA-5 IMPLANT - FULL WITH QID™ 365 CC - S 3
5231 10298 New FLASH ERF-34 IMPLANT ROUND 265 CC - S 3
5231 10298 New FLASH ERS-36 IMPLANT ROUND285 CC - S 1

per ciascun ordine(prima colonna es 5230) devo andare a ricercare nel mio inventario
che è composto così

ASTA-4 IMPLANT ANATOMIC 320 CC - S 1
ASTA-4 IMPLANT ANATOMIC 320 CC - S 1
ASTA-4 IMPLANT ANATOMIC 320 CC - S 1
ASTA-4 IMPLANT ANATOMIC 320 CC - S 1
ASTA-5 IMPLANT - FULL WITH QID™ 365 CC - S 1
ASTA-5 IMPLANT - FULL WITH QID™ 365 CC - S 1
ASTA-5 IMPLANT - FULL WITH QID™ 365 CC - S 1
ERF-34 IMPLANT ROUND 265 CC - S 1
ERF-34 IMPLANT ROUND 265 CC - S 1
ERF-34 IMPLANT ROUND 265 CC - S 1
ERS-36 IMPLANT ROUND285 CC - S 1
ERS-36 IMPLANT ROUND285 CC - S 1
i
nel mio inventario una riga è composta ad 1 quantità di quel singolo pezzo, in quanto anche il seriale è unico. Dunque se volessi riempire il mio ordine 5230 dovrei prendere 2 pezzi di ASTA-4 così
ASTA-4 IMPLANT ANATOMIC 320 CC - S 1
ASTA-4 IMPLANT ANATOMIC 320 CC - S 1

per moi manipolarli ed inserirli in uno specifico file, con apertura e chiusure delimitate.

Tralasciando perdere tutta la mia parte di importazione io ho fatto così


Public Sub filters()
Set Cbo = ThisWorkbook.Sheets("BodyCache")
Set wout = ThisWorkbook.Sheets("Outbound")
Set w_inv = ThisWorkbook.Sheets("Inventory")
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("OpenOrders") ' change name as needed
larow = Cells(Rows.Count, "A").End(xlUp).Row
Dim cs As Worksheet
Set cs = ThisWorkbook.Sheets("Cache")
Dim k As Integer
k = 1
Dim xloop, yloop, i
For xloop = 2 To larow
    Z = xloop + 1
    Dim word
    
    word = ws.Range("A" & xloop)
     For yloop = 2 To larow
     If word = ws.Range("A" & yloop) Then
     ws.Range("A" & yloop).EntireRow.Copy
     cs.Range("A" & k).PasteSpecial
     k = k + 1
     ws.Range("A" & yloop).EntireRow.Delete
     yloop = yloop - 1
     larow = larow - 1
     End If
     
     Next yloop
     
   Dim lxrow
   lxrow = Cells(Rows.Count, "E").End(xlUp).Row
   For i = 1 To lxrow
    varSKU = Trim(cs.Range("E" & i).Value)
    varQTA = Trim(cs.Range("G" & i).Value)
    
    w_inv.Activate
    Dim j As Integer
    w_inv.Range("A1").AutoFilter Field:=1, Criteria1:=cs.Range("E" & i).Value, visibledropdown:=True
    lRow = w_inv.Cells(Rows.Count, "A").End(xlUp).Row + 1
        If ActiveSheet.Range(Cells(1, 1), Cells(lRow, 1)).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        srow = w_inv.Cells(Rows.Count, "A").End(xlUp).Row
        w_inv.Range("A2:R" & srow).Sort Key1:=w_inv.Range("E2"), order1:=xlAscending, Header:=xlNo
        
        
        
        
        Else
        MsgBox "There is No Data for the Filtered Record:  " & varSKU
        Exit Sub
        End If
        
    Next i
    
Next xloop

End Sub

ora sorge il problema sapendo che del prodotto ASTA-4 Devo prendere 3 quantità come fareste voi a prendere quelle 2 righe su 4?
io mi sono fermato al riordine ma non riesco sapendo la quantità a portarmi via quelle righe.

7 Risposte

patel
Molto attivo
Iscritto da
giu, 2018
Messaggi:
550
Re: Filtering e Valori Righe
10 giu 2020, 16:23
Io non ho capito

Angelo_Tbp

Utente Attivo

Iscritto da: gen, 2014

Messaggi:: 439

Re: Filtering e Valori Righe

10 giu 2020, 21:41

Buona sera, allora se non ho capito male tu vorresti cancellare dall'inventario, dopo aver filtrato per ogni tipologia di prodotto, tante righe quante ne sono state indicate nella colonna quantità nel foglio degli ordini aperti giusto?

Se ho interpretato bene comincerei con il "razionalizzare" ma si può fare certamente di meglio… il codice:

Public Sub filters()
    Dim Cbo, wout, w_inv, ws, cs As Worksheet
    Dim larow, lxrow, lRow, srow As Integer
    Dim xloop, yloop, i, k As Integer
    Dim word, varSKU, varQTA As String
    
    Set Cbo = ThisWorkbook.Sheets("BodyCache")
    Set wout = ThisWorkbook.Sheets("Outbound")
    Set w_inv = ThisWorkbook.Sheets("Inventory")
    Set ws = ThisWorkbook.Sheets("OpenOrders") ' change name as needed
    Set cs = ThisWorkbook.Sheets("Cache")
    
    ws.Activate ' questo aiuta se lanci la macro da un foglio qualsiasi
    
    larow = Cells(Rows.Count, "A").End(xlUp).Row
    
    k = 1
    For xloop = 2 To larow 'legge tutti i codici uno alla volta
        Z = xloop + 1
        word = ws.Range("A" & xloop)
        For yloop = 2 To larow 'mi cerca il codice del ciclo esterno in tutte le righe
            If word = ws.Range("A" & yloop) Then
                ws.Range("A" & yloop).EntireRow.Copy
                cs.Range("A" & k).PasteSpecial
                k = k + 1
                ws.Range("A" & yloop).EntireRow.Delete
                yloop = yloop - 1
                larow = larow - 1
            End If
        Next yloop
    Next xloop
    
    'Questo ciclo for secondo ma andava tolto da quello sopra.. prima era tra i due next yloop e xloop
    lxrow = cs.Cells(Rows.Count, "E").End(xlUp).Row ' forse mancava cs. prima di Cells
    For i = 1 To lxrow
        varSKU = Trim(cs.Range("E" & i).Value)
        varQTA = Trim(cs.Range("G" & i).Value)
        w_inv.Activate
        w_inv.Range("A1").AutoFilter Field:=1, Criteria1:=cs.Range("E" & i).Value, visibledropdown:=True
        lRow = w_inv.Cells(Rows.Count, "A").End(xlUp).Row + 1
        'MsgBox (varSKU & " - " & varQTA & " - " & lRow) ' RIGA INFERIORE al filtro
        If ActiveSheet.Range(Cells(1, 1), Cells(lRow, 1)).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
            'MsgBox (srow) 'RIGA SUPERIORE al filtro
            srow = w_inv.Cells(Rows.Count, "A").End(xlUp).Row
            w_inv.Range("A2:R" & srow).Sort Key1:=w_inv.Range("E2"), order1:=xlAscending, Header:=xlNo
        Else
            MsgBox "There is No Data for the Filtered Record:  " & varSKU
            Exit Sub
        End If
    Next i
End Sub

a qesto aggiungo una domanda.. l'inventario presenta SEMPRE CONSECUTIVAMENTE i prodotti dello stesso tipo ognuno con quantità 1 oppure potrei trovarmi dopo il filtro con righe es. 12, 15, 19, 33 ? .. sarebbe molto più facile agire se i prodotti fossero SEMPRE elencati ordinatamente.. e i msgbox che ho aggiunto (quelli flaggati)dovrebbero darti un'idea…

Timer86
Utente Attivo
Iscritto da
giu, 2019
Messaggi:
69
Re: Filtering e Valori Righe
11 giu 2020, 09:56
Buongiorno a tutti, forse mi sono spiegato in maniera sbagliata, e vi chiedo Scusa.
in pratica una volta filtrato l'inventario, io devo prendere le celle che sono uscite come risultante del filtro e portarle in un nuovo foglio, successivamente eliminare quelle celle dell'inventario. il problema è chiaramente che coem sapete dalla risultante dell'active filter le celle che si generano sono sempre in posizioni diverse.
A
Angelo_Tbp
Utente Attivo
Iscritto da
gen, 2014
Messaggi:
439
Re: Filtering e Valori Righe
11 giu 2020, 15:43
Angelo_Tbp ha scritto:
Buona sera, allora se non ho capito male tu vorresti cancellare dall'inventario, dopo aver filtrato per ogni tipologia di prodotto, tante righe quante ne sono state indicate nella colonna quantità nel foglio degli ordini aperti giusto?

Timer86 ha scritto:
successivamente eliminare quelle celle dell'inventario.
..quindi deduco la risposta alla mia prima domanda sia affermativa!!!

Angelo_Tbp ha scritto:
l'inventario presenta SEMPRE CONSECUTIVAMENTE i prodotti dello stesso tipo ognuno con quantità 1 oppure potrei trovarmi dopo il filtro con righe es. 12, 15, 19, 33 ?

Timer86 ha scritto:
il problema è chiaramente che coem sapete dalla risultante dell'active filter le celle che si generano sono sempre in posizioni diverse.
..essere in posizioni diverse non significa necessariamente che non sono CONSECUTIVE… voglio capire se ad ogni selezione del filtro ti ritrovi SEMPRE con risultati posti in righe consecutive oppure no.. (ti ho fatto anche l'esempio nella domanda…)

Timer86 ha scritto:
Buongiorno a tutti, forse mi sono spiegato in maniera sbagliata, e vi chiedo Scusa.
in pratica una volta filtrato l'inventario, io devo prendere le celle che sono uscite come risultante del filtro e portarle in un nuovo foglio,
come si chiama questo nuovo foglio "Cache" per caso?

Puoi confermare le deduzioni / domande in maniera precisa?

Timer86

Utente Attivo

Iscritto da: giu, 2019

Messaggi:: 69

Re: Filtering e Valori Righe

19 giu 2020, 09:50

Ciao si,
scusatemi per il ritardo ma non mi era apparsa la notifica della risposta. Ora cerco di spiegarvi il tutto perbene
Mi sono espresso un po' male e ci riprovo

mi viene inviato un ordine in questo formato in excel,

Work Order No. Work Order ID Order Status Type Order SKU / Item SKU/Item Description Units - Requested
5230 10297 New FLASH ASM46Q NONE 2
5230 10297 New FLASH AS48Q NONE 3
5231 10298 New FLASH ER265Q NONE 3
5231 10298 New FLASH ER285Q NONE 1
5232 10458 New FLASH ER300Q NONE 1
5232 10458 New FLASH ER301Q NONE 2
5233 10459 New FLASH ASF0Q NONE 2
5233 10459 New FLASH AS46Q NONE 2
5234 10460 New FLASH ER85Q NONE 1
Dato questo documento che io mi importo, da qui si evince che

1) in un unico foglio ci possono essere più ordini(vedi colonna a sx)

2) il campo principale è la colonna SKU

Mentre l'inventario è composto così:
SKU / Item Serial EXP DATE Units - Available
ASFF-48Q 18100185 NONE 1
ASFF-48Q 18100229 NONE 1
ASFF-48Q 18100229 NONE 1
ASF0Q 18070474 NONE 1
ASF0Q 18080093 NONE 1
AS46Q 18080221 NONE 1
ASM46Q 18080242 NONE 1
ASM46Q 18090358 NONE 1
AS48Q 19040092 NONE 1
AS48Q 19040092 NONE 1
AS48Q 19040200 NONE 1
ER265Q 19065523 NONE 1
ER265Q 19065523 NONE 1
ER265Q 19070022 NONE 1
ER285Q 19035478 NONE 1
ER285Q 19035546 NONE 1
ER285Q 19035546 NONE 1
ER300Q 18115019 NONE 1
ER300Q 19056169 NONE 1
ER300Q 19065936 NONE 1
ERSD-320Q 19060336 NONE 1
ERSD-320Q 19065140 NONE 1
ERSD-320Q 19065140 NONE 1

da qui cosa devo fare?:

devo processare un ordine alla volta, verificare che la quantità esista, se lo è prelevarla e aggiornare l'inventario e da lì creare un file csv con tutto l'estratto dell'ordine e la colonna Serial.

come vedi l'inventario riportar più righe con lo stesso SKU, questo perchè l'inventario è gestito attraverso il codice seriale, che però non posso avere in fase di ordine.

Vorrei capire come poter processare un ordine alla volta, e dunque ricercare per ciascun ordine il codice articolo e prendere quindi il seriale dello stesso e salvarlo in un nuovo workbook.

questa è l'ultima variante di codice che ho fatto.


Public Sub filters()
Set Cbo = ThisWorkbook.Sheets("BodyCache")
Set wout = ThisWorkbook.Sheets("Outbound")
Set w_inv = ThisWorkbook.Sheets("Inventory")
Set var1 = ThisWorkbook.Sheets("VAR")
Set slMain = ThisWorkbook.Sheets("slMain")
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("OpenOrders") ' change name as needed
larow = ws.Cells(Rows.Count, "A").End(xlUp).Row
Dim cs As Worksheet
Set cs = ThisWorkbook.Sheets("Cache")
Dim k As Integer
k = 1
Dim xloop, yloop, i, ol, nloop
ol = 1
Dim n As Integer
n = 1
Dim varbody
Cbo.Range("A1:BA10000").ClearContents
cs.Range("A1:BA10000").ClearContents
wout.Range("A1:BA10000").ClearContents
p = 2
cont = 1
Dim lsw
lsw = 1
For xloop = 2 To larow
    Z = xloop + 1
    Dim word
    word = ws.Range("A" & xloop)
     For yloop = 2 To larow
     If word = ws.Range("A" & yloop) Then
     ws.Range("A" & yloop).EntireRow.Copy
     cs.Range("A" & k).PasteSpecial
     k = k + 1
     ws.Range("A" & yloop).EntireRow.Delete
     yloop = yloop - 1
     larow = larow - 1
     xloop = xloop - 1
     End If
     Next yloop
    w = 1
   Dim lxrow
   var1.Range("A2").Clear
   var1.Range("A1").Clear
   lxrow = cs.Cells(Rows.Count, "E").End(xlUp).Row
   'getting orders variable
   For i = 1 To lxrow
    varord = Trim(cs.Range("A" & i).Value)
        If varord = "" Then
        Exit For
        End If
    lsw = lsw + 1
    varSKU = Trim(cs.Range("E" & i).Value)
    varQTA = Trim(cs.Range("G" & i).Value)
    varCli = Trim(cs.Range("W" & i).Value)
    varPat = Trim(cs.Range("P" & i).Value)
    varCod = Trim(cs.Range("M" & i).Value)
    var1.Range("A1").Value = varQTA
    'this start a control if the old order is same as the new one, if yes there is no
    'need to start a new header and we can pin on the one below
   '   MsgBox (var1.Range("A2") & " " & varord)
        If Trim(var1.Range("A2").Value) <> varord Then
        p = 2
        wout.Range("A1") = "ORD"
        wout.Range("B1") = "111"
        wout.Range("C1") = varord
        wout.Range("E1") = "C"
        wout.Range("F1") = Trim(cs.Range("I" & i))
        wout.Range("K1") = Trim(cs.Range("S" & i))
        wout.Range("L1") = Trim(cs.Range("K" & i))
        wout.Range("M1") = Trim(cs.Range("L" & i))
        wout.Range("Q1") = Trim(cs.Range("D" & i))
        End If
    'Filtering for <> 0 then filtering on location <> 1 then filtering for SKU
    var1.Range("A2") = varord
    w_inv.Activate
    Dim j As Integer
    If ActiveSheet.FilterMode Then
     ActiveSheet.ShowAllData
    End If
    w_inv.Range("A1").AutoFilter Field:=7, Criteria1:=">0", visibledropdown:=True 'filter for units <> 0
    w_inv.Range("A1").AutoFilter Field:=6, Criteria1:="<>1", visibledropdown:=True 'filter for location <> 1
    w_inv.Range("A1").AutoFilter Field:=1, Criteria1:=varSKU, visibledropdown:=True 'filter for SKU

    lRow = w_inv.Cells(Rows.Count, "A").End(xlUp).Row + 1
      ' If w_inv.Range(Cells(1, 1), Cells(lRow, 1)).SpecialCells(xlCellTypeVisible).Cells.Count >= 1 Then
        rows1 = w_inv.Range(Cells(1, 1), Cells(lRow, 1)).SpecialCells(xlCellTypeVisible).Cells.Count - 1
        If rows1 >= 1 Then
        srow = w_inv.Cells(Rows.Count, "A").End(xlUp).Row
        w_inv.Range("A2:R" & srow).Sort Key1:=w_inv.Range("E2"), order1:=xlAscending, Header:=xlNo
        w_inv.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
        riga = Cells(Rows.Count, 1).End(xlUp).Row
'Starting the Search in the Inventory for a First SKU, positioning on the first sku line
        a = CInt(ActiveCell.Row) 'get row number
        ltable1 = w_inv.Range(Cells(1, 1), Cells(lRow, 1)).SpecialCells(xlCellTypeVisible).Cells.Count - 1
        ltable = ltable1 + a - 1 'get total row number considering qta and row active cell
        tmQTA = var1.Range("A1").Value
        MsgBox varord & " Ltable :" & ltable & "-Active Row: " & ActiveCell.Row
                    For nloop = ActiveCell.Row To ltable '3
                        If w_inv.Range("G" & nloop).Value > 0 Then
                        'copying in two different tables
                        'Written on Worksheet Outbound
                            If var1.Range("A1").Value >= w_inv.Range("G" & nloop) Then
                            Cbo.Range("A" & n) = "DET"
                            wout.Range("A" & p) = "DET"
                            wout.Range("B" & p) = n
                            wout.Range("C" & p) = w_inv.Range("A" & nloop)
                            wout.Range("D" & p) = w_inv.Range("G" & nloop)
                            wout.Range("E" & p) = w_inv.Range("C" & nloop)
                            wout.Range("G" & p) = varPat
                            wout.Range("I" & p) = varCod
                            wout.Range("J" & p) = varCli
                            var1.Range("A1").Value = var1.Range("A1").Value - w_inv.Range("G" & nloop).Value
                            w_inv.Range("G" & nloop).Value = 0
                            p = p + 1
                            w_inv.Range("A1").AutoFilter Field:=7, Criteria1:=">0", visibledropdown:=True
                                If var1.Range("A1").Value = 0 Then
                                    nloop = ltable
                                    Exit For
                                End If
                            ElseIf var1.Range("A1").Value = 0 Then
                            nloop = ltable
                            Exit For
                            Else
                            wout.Range("A" & p) = "DET"
                            wout.Range("B" & p) = n
                            wout.Range("C" & p) = w_inv.Range("A" & nloop)
                            wout.Range("D" & p) = w_inv.Range("G" & nloop)
                            wout.Range("E" & p) = w_inv.Range("C" & nloop)
                            wout.Range("G" & p) = varPat
                            wout.Range("I" & p) = varCod
                            wout.Range("J" & p) = varCli
                            w_inv.Range("G" & nloop).Value = w_inv.Range("G" & nloop).Value - var1.Range("A1").Value
                            w_inv.Range("A1").AutoFilter Field:=7, Criteria1:=">0", visibledropdown:=True
                            var1.Range("A1").Value = 0
                            nloop = ltable
                            p = p + 1
                            MsgBox varord & "2nd"
                            End If
                        End If
                        If nloop > ltable And tmQTA > 0 Then
                        MsgBox "Quantity not sufficient on this Row, SKU : " & varSKU & " Qty:" & varQTA & " order nbr:" & varord
                        slMain.Range("G" & lsw) = "Quantity not sufficient on this Row, SKU : " & varSKU & " Qty:" & varQTA & " order nbr:" & varord
                        lsw = lsw + 1
                        Exit Sub
                        End If
                  Next nloop
        End If
'Here the automation starts to make footer of the edms file
'with the IF is searching if the next record is the same that the actual, if yes
'it will skip the footer because it enter on the same order, if not it will then creater the footer file with addresses.

        If varord <> Trim(cs.Range("A" & i).Offset(1, 0)) Then
            If wout.Range("A" & p) <> "" Then
                Do Until wout.Range("A" & p) = ""
                    p = p + 1
                Loop
            End If
            If wout.Range("A2") <> "" Then
            wout.Range("A" & p) = "ADR"
            wout.Range("B" & p) = "CONS"
            wout.Range("C" & p) = Trim(cs.Range("W" & i))
            wout.Range("D" & p) = Trim(cs.Range("X" & i))
            wout.Range("E" & p) = Trim(cs.Range("Y" & i))
            wout.Range("F" & p) = Trim(cs.Range("Z" & i))
            wout.Range("G" & p) = Trim(cs.Range("AA" & i))
            wout.Range("H" & p) = Trim(cs.Range("AB" & i))
            wout.Range("I" & p) = Trim(cs.Range("AD" & i))
            wout.Range("J" & p) = Trim(cs.Range("AE" & i))
            wout.Range("K" & p) = Trim(cs.Range("AC" & i))
            wout.Range("L" & p) = Trim(cs.Range("AE" & i))
            wout.Range("M" & p) = Trim(cs.Range("AH" & i))
            wout.Range("N" & p) = Trim(cs.Range("AI" & i))
            Application.DisplayAlerts = False
            wout.Activate
            ThisWorkbook.Sheets("Outbound").Copy
            Dim sDate As String
            Dim gciCli As String
            sDate = Format(Now(), "ddmmyy")
            gciCli = "G3178621"
            'strFullname = "\\ziz.sys.com\DE1-str-fs\MIL-SYS\ElI\DMS\EDI.IN\" & gciCli & "_" & sDate & "_" & varord & "_" & cont & ".csv"
            strFullname = "c:\TESTFEF\" & gciCli & "_" & sDate & "_" & varord & "_" & cont & ".csv"
            ActiveWorkbook.SaveAs Filename:=strFullname, FileFormat:=xlCSV, CreateBackup:=True
            cont = cont + 1
            ActiveWorkbook.Close
            Windows("Motiva.xlsm").Activate
            wout.Range("A1:X10000").ClearContents
            slMain.Activate
            slMain.Range("G" & lsw) = "Message Sent to : " & strFullname & "...Successfully"
            lsw = lsw + 1
            End If
     End If
        
        
'Deeper:
        
    Next i

Next xloop
w_inv.ShowAllData
slMain.Activate


slMain.Range("G" & lsw) = "Operation Completed"
End Sub

Errori riportati dal debug 0, errori procedurali:
- mi skippa 2 ordini, credo che gli ordini e il calcolo delle quantità mi venga fatto più di una singola volta, quindi presumo che abbia sbaglio quei due cicli for concatenati.
- mi genera diversi file anzichè i file prescelti su base di ordine. Credo che dovrei trovare il modo di rimuovere quell xloop.

Timer86

Utente Attivo

Iscritto da: giu, 2019

Messaggi:: 69

Re: Filtering e Valori Righe

19 giu 2020, 09:55

Angelo_Tbp ha scritto:

Public Sub filters()
    Dim Cbo, wout, w_inv, ws, cs As Worksheet
    Dim larow, lxrow, lRow, srow As Integer
    Dim xloop, yloop, i, k As Integer
    Dim word, varSKU, varQTA As String
    
    Set Cbo = ThisWorkbook.Sheets("BodyCache")
    Set wout = ThisWorkbook.Sheets("Outbound")
    Set w_inv = ThisWorkbook.Sheets("Inventory")
    Set ws = ThisWorkbook.Sheets("OpenOrders") ' change name as needed
    Set cs = ThisWorkbook.Sheets("Cache")
    
    ws.Activate ' questo aiuta se lanci la macro da un foglio qualsiasi
    
    larow = Cells(Rows.Count, "A").End(xlUp).Row
    
    k = 1
    For xloop = 2 To larow 'legge tutti i codici uno alla volta
        Z = xloop + 1
        word = ws.Range("A" & xloop)
        For yloop = 2 To larow 'mi cerca il codice del ciclo esterno in tutte le righe
            If word = ws.Range("A" & yloop) Then
                ws.Range("A" & yloop).EntireRow.Copy
                cs.Range("A" & k).PasteSpecial
                k = k + 1
                ws.Range("A" & yloop).EntireRow.Delete
                yloop = yloop - 1
                larow = larow - 1
            End If
        Next yloop
    Next xloop
    
    'Questo ciclo for secondo ma andava tolto da quello sopra.. prima era tra i due next yloop e xloop
    lxrow = cs.Cells(Rows.Count, "E").End(xlUp).Row ' forse mancava cs. prima di Cells
    For i = 1 To lxrow
        varSKU = Trim(cs.Range("E" & i).Value)
        varQTA = Trim(cs.Range("G" & i).Value)
        w_inv.Activate
        w_inv.Range("A1").AutoFilter Field:=1, Criteria1:=cs.Range("E" & i).Value, visibledropdown:=True
        lRow = w_inv.Cells(Rows.Count, "A").End(xlUp).Row + 1
        'MsgBox (varSKU & " - " & varQTA & " - " & lRow) ' RIGA INFERIORE al filtro
        If ActiveSheet.Range(Cells(1, 1), Cells(lRow, 1)).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
            'MsgBox (srow) 'RIGA SUPERIORE al filtro
            srow = w_inv.Cells(Rows.Count, "A").End(xlUp).Row
            w_inv.Range("A2:R" & srow).Sort Key1:=w_inv.Range("E2"), order1:=xlAscending, Header:=xlNo
        Else
            MsgBox "There is No Data for the Filtered Record:  " & varSKU
            Exit Sub
        End If
    Next i
End Sub

I prodotti sono sempre ordinati come come anche i numeri di ordine

A
Angelo_Tbp
Utente Attivo
Iscritto da
gen, 2014
Messaggi:
439
Re: Filtering e Valori Righe
19 giu 2020, 21:19
Bentornato,
vedo che il tuo secondo codice è molto più lungo del primo e ho anche notato che i suggerimenti che ti ho postato nella mia rielaborazione del codice iniziale non sono stati apportati nella stesura dell'ultimo che hai postato…

Nella rielaborazione ti avevo scritto anche qualche commento sui cambiamenti che avevo apportato che "per pura combinazione" vanno ad affrontare alcune delle problematiche che hai esposto e mi riferisco a quando hai scritto :"<<… credo che gli ordini e il calcolo delle quantità mi venga fatto più di una singola volta…>>".

Dalla lettura del codice ho visto che hai aggiunto qualche altro foglio "VAR" e "slMain"... a cosa servono?

L'ultima tua affermazione: "<<I prodotti sono sempre ordinati come anche i numeri di ordine>>"
Mi lascia pensare che il problema sia risolvibile modificando di poco il primo codice… Ma la lettura del secondo mi ha un pò spiazzato, soprattutto in considerazione che i primi suggerimenti sono stati ignorati…

… ti suggerisco di rivedere il codice e di renderlo un po più leggibile (se lo ritieni opportuno vedi la mia rielaborazione del codice) e mi raccomando l'indentazione del codice

Devi accedere o registrarti per scrivere nel forum

7 risposte