CICLO DI ESTRAZIONE CONDIZIONATO

Hai un problema con Excel?

Nuova discussione

CICLO DI ESTRAZIONE CONDIZIONATO
di MotherVodka data: 16/07/2015 14:56:03
Non so come fare una macro ciclica che, estraendo da un FILE SECONDARIO raggruppi determinati dati in modo univoco e non ripetitivo IN UN ALTRO FILE
(IN QUESTO CASO HO FATTO UN ESEMPIO CON 2 CARTELLE DELLO STESSO DATABASE PER UN SEMPLICE MOTIVO DI INVIARVI 1 SOLA COPIA MA IMMAGINATE COME SE FOSSERO 2 FILE DIVERSI SU CARTELLE DIVERSE)

Il problema da risolvere oltre a raggruppare N Non Conformità per Periodo Storico ( In questo caso di Mese in Mese) è quello di Creare un Ciclo che a Determinate Condizioni ( sotto elencate) ripeta questo processo in Automatico.

CONDIZIONE 2) Crea UNA RIGA per Ogni Tipo Di Difetto Accreditato a Ogni Singolo Fornitore con la SOMMATORIA delle Quantita' Di Difetto
CONDIZIONE 2) Questo tipo di ciclo deve manifestarsi ogni volta che vengono introdotti i dati nel database principale ( come se fosse un controllo che non ci siano MODIFICE o AGGIORNAMENTI )
CONDIZIONE 1) I DATI RIELABORATI devono essere suddivisi per MESE come nell'esempio

QUINDI :
Per riepilogare..

1) DATABASE PRINCIPALE SU FILE DIVERSO
2) DATABASE FINALE SU FILE DIVERSO DOVE IMMETTERE I VALORI DESIDERATI
3) Controllo che il Processo (1°CICLO) si ripeta fino all'ULTIMA DATA DISPONIBILE del DATABASE PRINCIPALE CORRISPONDENTE ALL'ULTIMA DATA (riferimento di MESE IN MESE non DI GIORNO IN GIORNO)
4) 1°CICLO : CONTROLLO DELLA FINE DEL 2° CICLO PRIMA DI RIPETERE (COME SE FOSSE LA PRIMA VOLTA) IL PROCESSO (2° CICLO) SUL MESE SUCCESSIVO.
5 2°CICLO : (All'interno del 1° CICLO) : Cambio Fornitore del processo ( 3°CICLO) ogni volta che finisce il 3°CICLO STESSO.
6) 3°CICLO : (All'interno del 2°CICLO): controlla che per il FORNITORE DI RIFERIMENTO (definito nel 2°CICLO) vengano controllati tutti i TIPI DI DIFETTO PRESENTI e che vengano IMMESSI IN MODO SEQUENZIALE nel DATABASE FINALE in modo che le ripetizioni dei difetti dello stesso genere vengano visualizzati solo 1 VOLTA con la sommatoria delle quantita' di DIFETTO EMERSE. Ad ogni controllo effettuato comprensivo di tutte le tipologie di DIFETTO il LOOP DI QUESTO FORNITORE FINISCE.
In teoria se non ho detto troppe CAVOLATE dovrebbe ripetersi questo procedimento e sarebbe quello che vorrei poter fare:
l'UNICO CODICE CHE HO SCRITTO E' IL 3° CICLO MA MI SA CHE è PURE SBAGLIATO cmq ve lo pubblico così magari prendo anche dei suggerimenti.
Se potete ditemi come procedere.

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("B2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF((COUNTIFS('MODIFICA PRO FUTURE.xlsx'!Tabella1[REPORT DATA],"">=""&Foglio1!R4C7,'MODIFICA PRO FUTURE.xlsx'!Tabella1[REPORT DATA],""<=""&Foglio1!R4C8,'MODIFICA PRO FUTURE.xlsx'!Tabella1[FORNITORE],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R42C2,'MODIFICA PRO FUTURE.xlsx'!Tabella1[TIPOLOGIA NCR],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R3C1))>0,""A"""& _
        "UNTIFS('MODIFICA PRO FUTURE.xlsx'!Tabella1[REPORT DATA],"">=""&Foglio1!R4C7,'MODIFICA PRO FUTURE.xlsx'!Tabella1[REPORT DATA],""<=""&Foglio1!R4C8,'MODIFICA PRO FUTURE.xlsx'!Tabella1[FORNITORE],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R42C2,'MODIFICA PRO FUTURE.xlsx'!Tabella1[TIPOLOGIA NCR],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R5C1))>0,""B"",(IF((C"& _
        "MODIFICA PRO FUTURE.xlsx'!Tabella1[REPORT DATA],"">=""&Foglio1!R4C7,'MODIFICA PRO FUTURE.xlsx'!Tabella1[REPORT DATA],""<=""&Foglio1!R4C8,'MODIFICA PRO FUTURE.xlsx'!Tabella1[FORNITORE],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R42C2,'MODIFICA PRO FUTURE.xlsx'!Tabella1[TIPOLOGIA NCR],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R6C1))>0,""C"",(IF((COUNTIFS("& _
        " PRO FUTURE.xlsx'!Tabella1[REPORT DATA],"">=""&Foglio1!R4C7,'MODIFICA PRO FUTURE.xlsx'!Tabella1[REPORT DATA],""<=""&Foglio1!R4C8,'MODIFICA PRO FUTURE.xlsx'!Tabella1[FORNITORE],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R42C2,'MODIFICA PRO FUTURE.xlsx'!Tabella1[TIPOLOGIA NCR],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R7C1))>0,""D"",(IF((COUNTIFS('MODIFIC"& _
        "URE.xlsx'!Tabella1[REPORT DATA],"">=""&Foglio1!R4C7,'MODIFICA PRO FUTURE.xlsx'!Tabella1[REPORT DATA],""<=""&Foglio1!R4C8,'MODIFICA PRO FUTURE.xlsx'!Tabella1[FORNITORE],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R42C2,'MODIFICA PRO FUTURE.xlsx'!Tabella1[TIPOLOGIA NCR],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R8C1))>0,""E"",(IF((COUNTIFS('MODIFICA PRO FU"& _
        "'!Tabella1[REPORT DATA],"">=""&Foglio1!R4C7,'MODIFICA PRO FUTURE.xlsx'!Tabella1[REPORT DATA],""<=""&Foglio1!R4C8,'MODIFICA PRO FUTURE.xlsx'!Tabella1[FORNITORE],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R42C2,'MODIFICA PRO FUTURE.xlsx'!Tabella1[TIPOLOGIA NCR],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R9C1))>0,""F"",(IF((COUNTIFS('MODIFICA PRO FUTURE.xls"& _
        "a1[REPORT DATA],"">=""&Foglio1!R4C7,'MODIFICA PRO FUTURE.xlsx'!Tabella1[REPORT DATA],""<=""&Foglio1!R4C8,'MODIFICA PRO FUTURE.xlsx'!Tabella1[FORNITORE],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R42C2,'MODIFICA PRO FUTURE.xlsx'!Tabella1[TIPOLOGIA NCR],'[MODIFICA PRO FUTURE.xlsx]Andamento NCR TOTALE'!R10C1))>0,""G"",""FORNITORE ALTERNATIVO"")))))))))))))""& _
        "
    Range("B3").Select
End Sub

di totygno71 data: 16/07/2015 18:06:56
O_o
Cos'è quella... La divina commedia???

di Raffaele_53 data: 16/07/2015 20:49:35
Se ho capito bene...
Nel file che desideri avere il resoconto ci deve essere il foglio1. In questo premi ALT+F11, inserisci un modulo e poi copia a destra il codice. Salva come ".XLSM", nella stessa Directory di DATABASE PRINCIPALE con foglio DATI (casomai modifica il codice).
Verra creato una sigla in Colonna E, da qui farà i calcoli. Ogni volta che avvii il codice, prima cancella e poi lo ricrea. Se il Database (al quale vengono aggiunte solo alcune righe) è molto grande disabilità la riga ...If Ur > 1 Then sh2.Range("A2:E" & Ur).ClearContents... mettendoci davanti un '

EDIT --> Non considerare l'ultima frase "mettendoci davanti un ' "<--EDIT

Option Explicit
Sub Elabora()
Dim sh2 As Worksheet: Set sh2 = Worksheets("Foglio1") ' da cambiare casomai il nome foglio
Dim Percorso As String, nomeFile As String, fpath As String, Sigla As String
Dim Ur As Long, X As Long, Rg As Long, R As Long, RigaA As Object
Application.ScreenUpdating = False
fpath = ThisWorkbook.Path
nomeFile = "DATABASE PRINCIPALE.xlsx" ' da cambiare casomai il nome file
Workbooks.Open fpath & "" & nomeFile
Dim sh1 As Worksheet: Set sh1 = Worksheets("DATI")  ' da cambiare casomai il nome foglio
Ur = sh2.Range("A" & Rows.Count).End(xlUp).Row
    If Ur > 1 Then sh2.Range("A2:E" & Ur).ClearContents
Ur = sh1.Range("D" & Rows.Count).End(xlUp).Row
    sh1.Activate
    Columns("A:O").Select
    sh1.Sort.SortFields.Clear
    sh1.Sort.SortFields.Add Key:=Range("E2:E" & Ur), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With sh1.Sort
        .SetRange Range("A1:O" & Ur)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Rg = 2
    For X = 2 To Ur
        Sigla = sh1.Cells(X, 4) & " " & Month(sh1.Cells(X, 5)) & " " & sh1.Cells(X, 7)
        Set RigaA = sh2.Columns("E:E").Find(Sigla, LookIn:=xlValues, LookAt:=xlWhole)
        If RigaA Is Nothing Then
            sh2.Cells(Rg, 1) = DateSerial(Year(sh1.Cells(X, 5)), Month(sh1.Cells(X, 5)), 1)
            sh2.Cells(Rg, 2) = sh1.Cells(X, 4)
            sh2.Cells(Rg, 3) = sh1.Cells(X, 7)
            sh2.Cells(Rg, 4) = sh1.Cells(X, 15)
            sh2.Cells(Rg, 5) = Sigla
            Rg = Rg + 1
        Else
            R = RigaA.Row
            sh2.Cells(R, 4) = sh2.Cells(R, 4) + sh1.Cells(X, 15)
        End If
    Next X
Workbooks(nomeFile).Close False
Application.ScreenUpdating = True
MsgBox "Fatto"
Set sh1 = Nothing
Set sh2 = Nothing
Set RigaA = Nothing
End Sub

Vuoi Approfondire?