vba excel: sommare e contare al cambio di valore di cella

[karug64]

Salve a tutti.
Ho questo problema da risolvere ....
Ho un foglio derivante da una elaborazione sempre diversa (ma con formato delle colonne sempre uguale) (f_que) con circa 140.000 righe ordinato sulla colonna B cosi composto:
col A: cod
col B: id
colC: tipo
colD: des
colE: cau (questo valore puo' essere solo 1,2,3,4,5,6,7,8)
colF:imp


ovviamente per ogni "id" possono esserci "n" righe in cui colA,colB,colC,colD si ripetono sempre uguali e colE e colF variano sempre

Poi ho un altro foglio (f_rep) cosi' composto
col A: cod
col B: id
colC: tipo
colD: des
colE:n1
colF:t1
colG:n2
colH:t2
...
...
colS:n8
colT:t8

Su questo foglio ho un codice vba col quale, seleziono il foglio in questione, lo apro e ...............

Il risultato che dovrei ottenere dovrebbe essere questo:
nel foglio f_rep dovrei avere una riga per ogni "id" in cui riporto il contenuto delle colonne colA,colB,colC,colD e in n(x) quante volte è presente n(1,2,3,4,5,6,7,8) e in t(x) la somma di t(1,2,3,4,5,6,7,8)

Esempio f_que

Cod id tipo des cau imp
2 58 600 PE 1 316
2 58 600 PE 1 88
2 58 600 PE 1 2250
2 58 600 PE 6 2250
2 154 600 IM 2 800
2 154 600 IM 1 800
2 154 600 IM 1 700
2 254 600 IM 5 800
2 254 600 IM 5 500
2 254 600 Im 7 800


Esempio risultato f_rep

Cod id tipo des n1 t1 n2 t2 n3 t3 ... ..... n5 t5 n6 t6 .... n7 t7 ..... n8 ... t8
2 58 600 PE (n1=)3 (t1=)2.654 (n6=)1 (t6=)2250
2 154 600 IM (n1=)2 (t1=)1.500 (n2=)1 (t2=)800
2 254 600 IM (n5=)2 (t5=)1.500 (n7=)1 (t7=)800


Spero di essere stato chiaro.
Grazie

[Anthony47]

Dalle Linee guida per pubblicare le vostre domande, viewtopic.php?f=26&t=103911&p=605595#p605595

4) Se i dati da elaborare sono particolari o richiedono piu' di 2 (due) minuti per essere ricreati da chi vuole aiutarvi, allora e' bene allegare un file esemplificativo. Usate la procedura descritta in questo messaggio: viewtopic.php?f=26&t=103893&p=605487#p605487

Direi che allegando il file diventera' anche piu' chiara la struttura della tabella di output, al momento quasi illegibile.

Ciao

[karug64]

Ciao Anthony.
Ho praticamente risolto il problema con questo codice (che essendo stato scritto da me, farà rizzare i capelli agli esperti )

Codice: Seleziona tutto

If Sheets("Foglio1").Cells(5, 3).Value = "" Then
    MsgBox "Errore !! Nessun file contenente il risultato della query selezionato !!", vbCritical + vbOKOnly, "Errore"
    Exit Sub
Else

mypath = Sheets("Foglio1").Cells(5, 3).Value

Workbooks.Open Filename:=mypath
Sheets(1).Select
test = ""
fil = ""
intest = "Analisi di "
       
        test = Sheets(1).Range("A1").Value
       
        If Sheets(1).Range("A1").Value <> "inseriment" Then
            ' NO OK file errato
            MsgBox "Hai selezionato il file ERRATO !!", vbCritical, "Errore"
            Sheets(1).Select
            ActiveWindow.Close savechanges:=False
            Exit Sub
           
        Else
            ' OK elaboro
            ' elaboro
            Application.ScreenUpdating = False
           
            Set wk_report = ActiveWorkbook
            Set wk_query = Workbooks.Open(mypath)
            Set sh_report = ThisWorkbook.Worksheets(2)
            Set sh_query = Worksheets(1)
           
         
            fil = sh_query.Cells(2, 1).Value
            If Len(Trim(fil)) <> 0 Then
                intest = intest + Right("000" + fil, 3)
                sh_report.Cells(1, 1).Value = intest
            End If
           
            ' ora leggo le righe
            ultimariga = 0
            ultimariga = sh_query.Range("A1").End(xlDown).Row
           
           
            tmp_cdg = 0
            tmp_set = 0
            tmp_fil = 0
            tmp_des = ""
            tmp_att = ""
           
            n2 = 0
            n11 = 0
            n12 = 0
            n13 = 0
            n15 = 0
            n21 = 0
            n52 = 0
            n78 = 0
           
            t2 = 0
            t11 = 0
            t12 = 0
            t13 = 0
            t15 = 0
            t21 = 0
            t52 = 0
            t78 = 0
           
            totn = 0
            totimp = 0
 
            cdg_rep = 0
            cdg_que = 0
           
            riga_que = 1
            riga_rep = 5
                       
            For x = 2 To ultimariga
           
                cdg_que = sh_query.Cells(x, 2).Value
               
                If x = 2 Then
                    ' primo ciclo
                    cdg_rep = cdg_que
                    tmp_fil = sh_query.Cells(x, 1).Value
                    tmp_set = sh_query.Cells(x, 3).Value
                    tmp_des = sh_query.Cells(x, 4).Value
                    tmp_att = sh_query.Cells(x, 5).Value
                    If sh_query.Cells(x, 10).Value = 2 Then
                        n2 = n2 + 1
                        t2 = t2 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 11 Then
                        n11 = n11 + 1
                        t11 = t11 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 12 Then
                        n12 = n12 + 1
                        t12 = t12 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 13 Then
                        n13 = n13 + 1
                        t13 = t13 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 2 Then
                        n15 = n15 + 1
                        t15 = t15 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 21 Then
                        n21 = n21 + 1
                        t21 = t21 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 52 Then
                        n52 = n52 + 1
                        t52 = t52 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 78 Then
                        n78 = n78 + 1
                        t78 = t78 + sh_query.Cells(x, 12).Value
                    End If
               
                    GoTo esci_primo
               
                End If
               
                If cdg_que <> cdg_rep Then
                       
                        riga_rep = riga_rep + 1
                        sh_report.Cells(riga_rep, 1).Value = cdg_rep
                        sh_report.Cells(riga_rep, 2).Value = tmp_set
                        sh_report.Cells(riga_rep, 3).Value = tmp_des
                        sh_report.Cells(riga_rep, 4).Value = tmp_att
                        If n2 <> 0 Then
                            sh_report.Cells(riga_rep, 5).Value = n2
                        End If
                        If t2 <> 0 Then
                            sh_report.Cells(riga_rep, 6).Value = t2
                        End If
                        If n11 <> 0 Then
                            sh_report.Cells(riga_rep, 7).Value = n11
                        End If
                        If t11 <> 0 Then
                            sh_report.Cells(riga_rep, 8).Value = t11
                        End If
                        If n12 <> 0 Then
                            sh_report.Cells(riga_rep, 9).Value = n12
                        End If
                        If t12 <> 0 Then
                            sh_report.Cells(riga_rep, 10).Value = t12
                        End If
                        If n15 <> 0 Then
                            sh_report.Cells(riga_rep, 11).Value = n15
                        End If
                        If t15 <> 0 Then
                            sh_report.Cells(riga_rep, 12).Value = t15
                        End If
                        If n21 <> 0 Then
                            sh_report.Cells(riga_rep, 13).Value = n21
                        End If
                        If t21 <> 0 Then
                            sh_report.Cells(riga_rep, 14).Value = t21
                        End If
                        If n78 <> 0 Then
                            sh_report.Cells(riga_rep, 15).Value = n78
                        End If
                        If t78 <> 0 Then
                            sh_report.Cells(riga_rep, 16).Value = t78
                        End If
                        If n13 <> 0 Then
                            sh_report.Cells(riga_rep, 19).Value = n13
                        End If
                        If t13 <> 0 Then
                            sh_report.Cells(riga_rep, 20).Value = t13
                        End If
                        If n52 <> 0 Then
                            sh_report.Cells(riga_rep, 21).Value = n52
                        End If
                        If nt2 <> 0 Then
                            sh_report.Cells(riga_rep, 22).Value = t52
                        End If
                                                   
                        tmp_cdg = 0
                        tmp_set = 0
                        tmp_fil = 0
                        tmp_des = ""
                        tmp_att = ""
           
                        n2 = 0
                        n11 = 0
                        n12 = 0
                        n13 = 0
                        n15 = 0
                        n21 = 0
                        n52 = 0
                        n78 = 0
           
                        t2 = 0
                        t11 = 0
                        t12 = 0
                        t13 = 0
                        t15 = 0
                        t21 = 0
                        t52 = 0
                        t78 = 0
                        cdg_rep = cdg_que
                    Else

                    tmp_fil = sh_query.Cells(x, 1).Value
                    tmp_set = sh_query.Cells(x, 3).Value
                    tmp_des = sh_query.Cells(x, 4).Value
                    tmp_att = sh_query.Cells(x, 5).Value
                   
                    If sh_query.Cells(x, 10).Value = 2 Then
                        n2 = n2 + 1
                        t2 = t2 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 11 Then
                        n11 = n11 + 1
                        t11 = t11 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 12 Then
                        n12 = n12 + 1
                        t12 = t12 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 13 Then
                        n13 = n13 + 1
                        t13 = t13 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 2 Then
                        n15 = n15 + 1
                        t15 = t15 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 21 Then
                        n21 = n21 + 1
                        t21 = t21 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 52 Then
                        n52 = n52 + 1
                        t52 = t52 + sh_query.Cells(x, 12).Value
                    End If
                   
                    If sh_query.Cells(x, 10).Value = 78 Then
                        n78 = n78 + 1
                        t78 = t78 + sh_query.Cells(x, 12).Value
                    End If
                    End If
           
esci_primo:
            Next x
        End If
End If


Unico problema, quando l'ID è presente una sola volta, non mi riporta i dati nel riepilogo .....

E poi un altro più importante:
l'elaborazione da leggere di oltre 140.000 righe è in un file csv.
Avrei bisogno di leggerlo cosi' com'e' in quanto l'elaborazione dovra' girare su un office 2003 e se apro il file (open) mi carica solo le prime 65.5.. righe ...


Ecco il file di esempio :

http://www.filedropper.com/cartel1

Grazie

[Flash30005]

La macro non l'ho capita
sembra manchi qualcosa

il problema delle righe è dovuto al fatto che pur avendo office 2010 (come dichiari in firma)
utilizzi un file di Excel per versione 2003 e quindi non vai oltre le 65536
se, invece userai un file di Excel versione superiore (2007, 2010 o oltre)
importerai le 14.000 righe

il file da te inviato come esempio non spiega come ottieni i dati che inserisci nelle cella al di sotto della testata che chiami con i seguenti nomi

n1 t1 n2 t2 n3 t3 n4 t4 n5 t5 n6 t6 n7 t7 n8 t8

cioè in n1 noto che è il conteggio delle righe appartenenti allo stesso ID ma il resto è tabu

ciao

[karug64]

Buongiorno.
Il problema della lettura delle righe sta nel fatto che nel mio oc c'e' office 2010 ma il programma lavorerà su pc con office 2003. Quindi sul mio potrei lasciare l'apertura (open) del file query.xlsx, ma così facendo sul pc da lavoro il programma non funzionerebbe.
Necessito, quindi, di leggere il file di origine csv in maniera sequenziale estrapolandone i singoli campi.

Per quanto riguarda il file di esempio, esprime "per ogni ID" il Numero di volte (n1) che una causale (cau) si ripete e il totale (t1) per quella causale.
Poichè, come detto in premessa, le causali possono essere solo 1,2,3,4,5,6,7,8 ho messo , nel riepilogo , le colonne n1,t1, n2,t2, ..... n8,t8.

Spero di essere stato chiaro.

Grazie

[Flash30005]

Per importare 140.000 righe in un foglio di Excel versione 2003 devi occupare almeno 3 fogli (65000 x 3 = 195000 righe)

per quanto riguarda la distribuzione Cau non capisco come mai gli 1 (T1) differenziano nel tuo esempio
con 58 3 2654
con 154 8 5600
come mai gli 1 sono 2654 per id 58 e 5600 per id 154?
non dovrebbero essere uguali?

ciao

[Anthony47]

Guarda il messaggio di Flash, prima di questo.

La mia considerazione e' che questo che chiedi e' il lavoro tipico della tabella pivot:
-metti CAU nell' area Colonna
-metti ID nell' area Righe
-metti IMP nell' area Dati, una volta come "Conteggio di" e un'altra come "Somma di"
-cerchi poi un layout di tabella piu' simile a quanto vorresti ottenere
Altre cose mi pare che siano facilmente estraibili dalla tabella di partenza con un Cerca.vert

Rimane il problema di aprire 170mila righe con XL2003, ma qui potrebbe aiutarti questa procedura Microsoft: http://support2.microsoft.com/default.a ... -us;120596

Avendo i dati distribuiti su piu' fogli dovrai usare l' opzione "Piu' intervalli di consolidamento" quando imposti la tabella pivot.

La tabella pivot e' uno strumento importante di Excel, io preferisco suggerirti di impararle a usare piuttosto che darti una macro che ti evita di approfondire... almeno per ora.

Ciao

[karug64]

Intanto grazie per l'interessamento. Cerco di spiegarmi meglio.
Io non devo (e non posso) importare tutte le righe in excel 2003: non ci dovrebbe essere bisogno.
Infatti, la mia idea, è quella di leggere il CSV riga per riga e di scrivere il risultato su un foglio di excel 2003. Tale operazione comporterà, in media, una scrittura max di 6000 righe.

Quindi io pensavo di creare un ciclo di lettura del file CSV, elaborare riga per riga , e al cambio di ID scrivere la riga "riepilogativa" sul foglio excel 2003.

Per quanto riguarda l'esempio ti spiego:
l'ID 53 presenta 3 movimenti con cau = 1 : nel riepologo ho quindi la riga dell'ID 53 con n1(=numero di presenze cau 1) = 3 e t1 (=somma di imp) = 2.654 (316,00+ 88,00+2.250,00)
l'ID 154 presenta 8 movimenti con cau=1 quindi (n1=8) la cui somma di imp è uguale a 5.600 (800+800+700+800+800+800+400+500)
inoltre presenta 7 movimenti con cau=2, quindi (n2=7) la cui somma di imp è uguale a 3.850,00 (500+800+200+800+800+500+250)
e 5 movimenti con cau=3, quindi(n3=5) la cui somma di imp è uguale a 3.500,00 (800+800+300+800+800)

e così via ....

Alla fine è quasi come avere una tabella pivot, ma il risultato lo devo ottenere tramite vba in quanto all'interno del ciclo principale avrò necessità di inserire una serie di controlli e condizioni varie.

Spero di essermi spiegato.
Grazie



P.S.
Scusa Anthony hai risposto mentre scrivevo. Senza saperlo ho risposto anche al tuo suggerimento sulla pivot.....

[Flash30005]

Ma gli Id sono già ordinati in ordine crescente così come lo noto sul tuo file esempio?

Cioè non troverò mai
58
58
58
154 ( e poi)
58

giusto?

[karug64]

Ma gli Id sono già ordinati in ordine crescente così come lo noto sul tuo file esempio?

Cioè non troverò mai
58
58
58
154 ( e poi)
58

giusto?

Si.
Il file esce fuori dall'elaborazione ordinato per ID dal più piccolo al più grande, quindi non ci sono salti e/o ripetizioni.

[Flash30005]

Prova questa macro per la compilazione

Codice: Seleziona tutto

Sub ElencoID()
URID = Range("B" & Rows.Count).End(xlUp).Row
Range("L3:AF" & URID).ClearContents
MMID = 0
For RR1 = 2 To URID
    MyID = Range("B" & RR1)
    Cau = Range("F" & RR1) * 2
    If MyID <> MMID Then
        RigaI = Range("Q" & Rows.Count).End(xlUp).Row + 1
        Range("A" & RR1 & ":E" & RR1).Copy Destination:=Range("L" & RigaI)
        Cells(RigaI, 15 + Cau).Value = 1
        Cells(RigaI, 16 + Cau).Value = Range("G" & RR1).Value
        MMID = MyID
    Else
        Cells(RigaI, 15 + Cau).Value = Cells(RigaI, 15 + Cau).Value + 1
        Cells(RigaI, 16 + Cau).Value = Cells(RigaI, 16 + Cau).Value + Range("G" & RR1).Value
    End If
SaltaRR1:
Next RR1

End Sub

Ciao