SubTotali in vba - come ottenerli

I questo esercizio che presento, vedremo come applicare dei subtotali ad un elenco di dati, nei campi (colonne) che ospitano valori numerici. Vedremo anche la stessa tecnica applicata ad un elenco filtrato, e come evidenziare in grassetto i caratteri dei subtotali, cambiando anche colore sia ai fonts sia alle celle.

Oltre a svariate procedure che possiamo realizzare con istruzioni appropriate in vba, questa volta seguiremo una procedura tipica del foglio di lavoro, tradotta in codice vba, che è quella che possiamo ottenere tranquillamente (senza bisogno del codice) andando sul menù Dati e scegliendo l'opzione "Subtotali". Questa procedura da foglio è già stata descritta su questo sito, sezione "primi passi", articolo "Usare il filtro".

Ottenere subtotali è una necessità che si può avere quando si disponga di elenchi dati di cui vogliamo dei parziali relativamente ad un periodo (es: una data di fine mese in un elenco fatture), oppure ad un nominativo, oppure a quanto venduto di un determinato articolo, ecc. ecc. Le necessità di ognuno sono tante che è impossibile esemplificarle, l'importante è afferrare il concetto. Vediamo una tabella creata come esempio:

In questa tabella troviamo 5 campi: data fatt, nominativo, imponibile, iva, totale (imp. + iva); se si dovesse identificare i campi con un numero (che in una tabella parte sempre da sinistra), data fatt sarebbe il numero 1, nominativo il numero 2, ecc. ecc.; parlo di numeri e non di intestazioni di campo, perchè gli "argomenti" del metodo vba "Subtotal" che useremo, identificano i campi su cui agire in base al "numero di campo".

Dovremo altresì decidere in base a quale "Gruppo" ottenere i subtotali (per gruppo si intendono ognuno dei campi a disposizione), cioè in questo esempio, dovremo decidere se vorremo i subtotali organizzati per il "Gruppo" "Data fatt" oppure "Nominativo", visto che mi sembra assurdo volerlo per gli altri campi, di cui invece vorremo la SOMMA. Vediamo intanto la sintassi del Metodo Subtotal: (tra parentesi gli argomenti separati da una virgola)

espressione.Subtotal(GroupBy, Function, TotalList, Replace, PageBreaks, SummaryBelowData)
(invito i "pellegrini" ad abituarsi a consultare la "guida in linea (vedi)" digitanto Subtotal in "cerca" e selezionando "Metodo Subtotal" nella finestra degli argomenti trovati, per leggersi i significati relativi agli argomenti)

Ed ora vediamo due esempi della procedura, nella quale organizzeremo i Subtotali raggruppati prima per data fatt. e poi per nominativo, con relative immagini:

Sub ApplicaSubtotali()
'per prima cosa identifichiamo l'area, compreso le intestazioni di campo, su cui agire. 'Poichè si presuppone che non sapremo quanto lungo sarà il nostro elenco, usiamo End 'per reperire l'ultima cella occupata lato destro della tabella, ed assegniamo l'area alla 'variabile "zona":
Set zona = Range(Cells(3, 1), Cells(3, 5).End(xlDown))
'ora applichiamo a "zona" i subtotali, organizzandoli per "Data fatt.", campo n. 1 (GroupBy:=1), usando la funzione Somma (Function:=xlSum), e chiedendo il subtotale ai campi 3, 4 e 5 (imponibile,iva, totale) con (totallist:=Array(3, 4, 5)). L'istruzione sotto è 'tutta unica, si va a capo con _ (barra bassa) per mancanza di spazio
zona.Subtotal GroupBy:=1, Function:=xlSum, totallist:=Array(3, 4, 5), _
Replace:=True, PageBreaks:=False , SummaryBelowData:=True

End Sub

e questa è l'immagine del risultato in cui si vedono i subtotali organizzati in funzione delle date uguali :

Vediamo subito anche un'altra routine necessaria : la rimozione dei subtotali, una volta analizzati i risultati. Capire queste istruzioni è facile: si identifica l'area a cui si sono applicati i subtotali (zona) e si rimuovonocon RemoveSubtotal:

Importante: questo risultato con i subtotali organizzati per Gruppi di date è stato ottenuto grazie all'ordinamento progressivo ascendente con cui le fatture sono state registrate, cioè ogni fine mese, e quindi le date uguali sono una seguente all'altra. Ma cosa succederà quando andremo ad applicare il subtotale sul campo"Nominativo", che non porta i nominativi "raggruppati", ma distesi nei vari mesi? Succederebbe che per ogni nominativo verrebbe fornito un subtotale, in quanto cambia il nominativo ad ogni riga, ed otterremmo un elenco molto lungo di subtotali che non servirebbero allo scopo. E allora? Allora impariamo una regola che dovremo tenere sempre presente: dovremo "raggruppare" i Nominativi (in questo caso) usando un ordinamento che ponga in ordine alfabetico i nominativi (e quindi raggruppandoli), e i loro dati correlati. In questo modo è come se applicassimo un filtro che riunisca tutti i valori uguali, solo che anzichè filtrare un nominativo per volta, li "filtriamo" tutti.

Inseriremo le istruzioni per l'ordinamento PRIMA delle istruzioni per i subtotali, ed il gioco è fatto. Vediamo le istruzioni e l'immagine del risultato:

Sub ordinaapplicaSt()
'impostiamo la zona su cui agire
Set zona = Range(Cells(3, 1), Cells(3, 5).End(xlDown))

'sotto; con la zona, applichiamo l'ordinamento ascendente sul campo Nominativo, che 'inizia come dati dalla cella B4
With zona
.Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With

'indi usiamo il metodo Subtotal agendo sul GroupBy:=2 , cioè il campo Nominativo
zona.Subtotal GroupBy:=2, Function:=xlSum, totallist:=Array(3, 4, 5), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub

Anche qui vorremo rimuovere i subtotali, ma dovremo seguire una strada diversa rispetto alle istruzioni per la rimozione vista sopra in quanto abbiamo modificato anche l'ordinamento di tutti i dati. In questo caso, dovremo ricostruire l'elenco come era in origine, impostato sulle date fattura ed useremo ancora un ordinamento ascendente ma basato questa volta sulla chiave "Data fatt.", cioè sulla colonna A a partire dalla cella A4, e queste le rispettive istruzioni, ma con l'istruzione RemoveSubtotal posta PRIMA di quella sull'ordinamento:

Questa procedura in realtà non ripristina la tabella proprio come era all'origine, in quanto si avrà un ordinamento progressivo sulle date, ma con nominativi posti in ordine alfabetico; nessun danno perchè gli importi relativi ad ogni nominativo saranno quelli giusti, ma.....esiste un'altro modo, che dovremo prevedere quando creeremo i campi di una tabella: lasceremo la prima colonna, la A, come colonna contatore, partendo quindi da uno incrementando una unità per ogni riga. In questo modo, se applicheremo ordinamenti basati su date, o nominativi, o altro, potremo sempre ritornare all'ovile scegliendo come chiave d'ordinamento per il ripristino, la colonna con i numeri, ed i dati ritorneranno veramente come prima.

Come promesso in apertura articolo, ora vediamo come colorare caratteri, renderli grassetto, e colorare le celle che ospiteranno i sub totali. Vediamo subito un immagine che chiarisce cosa intendo, e poi la routine e le spiegazioni:

Per la routine useremo una macro a parte, che richiameremo a fine di una delle precedenti routine, in modo che applicheremo l'ordinamento, i sub totali e infine questa:

Sub ColoraSt()
Dim CL As Object

'sotto: settiamo come zona SOLO le celle della colonna sulla quale stiamo applicando i 'subtotali, nell'esempio sopra, la colonna 2 (nominativo) dalla B3 all'ultima cella occupata
Set zonac = Range(Cells(3, 2), Cells(3, 2).End(xlDown))

'inizia il ciclo per ogni cella in zonac
For Each CL In zonac

'per identificare su quale riga si formeranno i subtotali (non possiamo predeterminarlo 'prima), cerchiamo la parola "Totale", che può trovarsi la prima a destra o l' ultima a 'sinistra nelle celle che spazzoliamo con in ciclo For Each, se "Totale" viene trovato, 'allora:
If Right(CL.Value, 6) = "Totale" Or Left(CL.Value, 6) = "Totale" Then

'con la cella (CL) così trovata, impostiamo il colore rosso al font ed il grigio nella cella:
With CL
.Font.ColorIndex = 3
.Interior.ColorIndex = 15

'con Offset(0, 1) identifichiamo la cella a destra di quella trovata e coloriamo, 'aggiungendo il Grassetto al font
.Offset(0, 1).Font.ColorIndex = 3
.Offset(0, 1).Interior.ColorIndex = 15
.Offset(0, 1).Font.Bold = True

'lo stesso facciamo con la cella : due celle a destra (Offset(0 , 2))
.Offset(0, 2).Font.ColorIndex = 3
.Offset(0, 2).Interior.ColorIndex = 15
.Offset(0, 2).Font.Bold = True

'e quindi con la terza (Offset(0 , 3))
.Offset(0, 3).Font.ColorIndex = 3
.Offset(0, 3).Interior.ColorIndex = 15
.Offset(0, 3).Font.Bold = True

End With ' fine con
End If
Next 'passa alla cella successiva fino alla fine delle celle in zonac
End Sub

E quindi la routine "ordinaapplicaSt" vista sopra, con l'aggiunta del richiamo alla macro ColoraSt, diventa così:

Sub ordinaapplicaSt()
'impostiamo la zona su cui agire
Set zona = Range(Cells(3, 1), Cells(3, 5).End(xlDown))

ColoraSt 'si richiama la macro per colorare fonts e celle

End Sub

Quando si rimuoveranno i subtotali, usando la macro RimuoviordinaapplicaSt() spariranno anche le impostazioni di colore e grassetto, senza bisogno di aggiungere istruzioni. Ognuno potrà scegliersi i colori che preferirà semplicemente cambiando il valore assegnato a ColorIndex. (per la tabella Colori vedi in questa sezione : "Colori e ColorIndex").