Archivio da orizzontale a verticale colorato

[ikwae]

Ciao a tutti… recuperate righe di codice qua e là e, per i colori, ho preso spunti da
precedenti aiuti ho completato una macro velocissima con i conteggi giusti e tutta “colorata”.

Tuttavia non avendo la più pallida idea di come strutturate le macro chiedo aiuto a tutto il Forum.
L’aiuto che cerco è di verificare la macro (quella del colore):
1) se strutturalmente è “coerente”
2) se è dimensionata correttamente specialmente la parte inerente alle dichiarazioni del colore
3) se c’è qualche riga di codice incongruente o superflua
4) se si riesce a migliorarla

La macro esegue i seguenti passi:
1) copia il concorso scritto in K2 lo replica per 11 volte e lo incolla a partire da B2
2) copia la data scritta in L2 la replica per 11 volte e la incolla a partire da C2
3) copia le cinquine della riga M2:BO2 e le traspone in colonne D2:H12
4) applica il colore alle celle e il colore del carattere, delle cinquine, copiandolo dalle celle in BQ3:BQ13
a5) scrive in colonna I, da I2, le 11 ruote colorando solo la 1à (BA) con il colore e font di BQ2
6) copia il concorso scritto in K3, ecc. ripete il ciclo fino a fine archivio.

In allegato un foglio Demo, con due tasti, uno manda in esecuzione la macro senza colore e l’alto
con il colore per avere un’indicazione di come lavora la macro.
Rammento a me serve aiuto solo alla macro che applica il colore.

Note: il foglio Altri è per tutti coloro che vogliono usare le mie macro ad uso didattico o studio.
Penso di fare cosa utile dato che in rete dopo ore e ore di ricerche, per una macro simile, non ho
trovato nulla e ho decido di modificare aggiungendo del codice ad una macro tipo che ho trovato.
Anche il foglio Altri ha due tasti per mandare in esecuzione la macro con e senza colore.

Per un archivio dal 1939 a oggi, entrambe le macro, sono istantanee mentre per l’archivio
dal 1871(trovato in rete) a oggi impiega una manciata di secondi e, per il colore, qualche
istante in più con il processore che lavora al 13% di potenza. Sempre molto meno del minuto.

Ringraziando anticipatamente tutti coloro che mi daranno aiuto 73 ikwae

http://www.filedropper.com/archiviodaor ... loratorete

[Anthony47]

Io dico sempre che se una cosa funziona bene allora e’ perfetta per l'uso. Se funziona bene lo puoi dire solo tu, e mi pare che abbia detto che funziona bene; quindi potremmo chiuderla qui…

Pero’, giacche’ ci siamo, possiamo fare qualche disquisizione in ordine sparso...

A) a proposito di Dim
Dichiarare le variabili serve innanzitutto per allocarne in modo preventivo lo spazio, e quindi guadagnare qualche microsecondo al momento del loro utilizzo. A questo scopo pero’ e’ importante dichiararne anche il tipo.
Per l’elenco dei tipi, vedi https://docs.microsoft.com/it-it/office ... pe-summary
Il tipo Variant e’ quello di default

Serve anche a chiarirsi le idee (in genere dichiari una cosa che hai chiara in mente) e, insieme a Option Explicit (vedi https://docs.microsoft.com/it-it/office ... -statement ) a evitare sorprese dovute a errori di battitura

Il Color e’ di tipo Long; lasciarlo Variant (il tipo di default) ti costera’ qualche microsecondo in piu’ a ogni scrittura.

B) a proposito di chiarezza
Se scrivi codice per te stesso, qualsiasi modo che va bene a te e’ sufficiente.
Se vuoi farlo capire ad altri allora e’ meglio presentare il codice in blocchi facilmente leggibile.
Vedi tu tra questi due listati quale e’ piu’ facile da capire:
Orginale:

Codice: Seleziona tutto

   For A = LBound(Matrice, 1) To UBound(Matrice, 1)
        Rba = 3 'Contatore Per Colore Celle e Font 5ne
         For B = 1 To 11
   
'SCRIVE IL CONCORSO IN B:B(end) OK VA BENE
 Range(Init5na).Offset((A - 1) * 11, -2).Resize(11, 1) = Matrice(A, 1)

'SCRIVE LA DATA IN C:C(end) OK VA BENE
 Range(Init5na).Offset((A - 1) * 11, -1).Resize(11, 1) = Matrice(A, 2)

           For C = 1 To 5

'SCRIVE LA 5na IN D2:H(end) OK VA BENE
 Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1) = Matrice(A, (B - 1) * 5 + C + 2)
 
'IMPOSTAZIONI PER COLORE CELLA E FONT 5na
 Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1).Interior.Color = Range("BQ3").Cells(A, 1).Interior.Color
 Color5a = Cells(Rba, 69).Interior.Color
 Font5na = Cells(Rba, 69).Font.Color
 
'COLORE SOLO CELLA 5na
 Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1).Interior.Color = Color5a
 
'COLORE SOLO CARATTERE 5na
 Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1).Font.Color = Font5na
     
       Next C
          Rba = Rba + 1 'Contatore Per Colore Celle e Font 5ne
   Next B
          Rba = Rba + 1 'Contatore Per Colore Celle e Font 5ne
Next A

Editato:

Codice: Seleziona tutto

For A = LBound(Matrice, 1) To UBound(Matrice, 1)
    Rba = 3 'Contatore Per Colore Celle e Font 5ne
    For B = 1 To 11
        'SCRIVE IL CONCORSO IN B:B(end) OK VA BENE
        Range(Init5na).Offset((A - 1) * 11, -2).Resize(11, 1) = Matrice(A, 1)
        'SCRIVE LA DATA IN C:C(end) OK VA BENE
        Range(Init5na).Offset((A - 1) * 11, -1).Resize(11, 1) = Matrice(A, 2)
        For C = 1 To 5
        'SCRIVE LA 5na IN D2:H(end) OK VA BENE
             Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1) = Matrice(A, (B - 1) * 5 + C + 2)
            'IMPOSTAZIONI PER COLORE CELLA E FONT 5na
             Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1).Interior.Color = Range("BQ3").Cells(A, 1).Interior.Color
             Color5a = Cells(Rba, 69).Interior.Color
             Font5na = Cells(Rba, 69).Font.Color
            'COLORE SOLO CELLA 5na
             Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1).Interior.Color = Color5a
            'COLORE SOLO CARATTERE 5na
             Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1).Font.Color = Font5na
        Next C
        Rba = Rba + 1 'Contatore Per Colore Celle e Font 5ne
    Next B
    Rba = Rba + 1 'Contatore Per Colore Celle e Font 5ne
Next A

In questo secondo caso ogni blocco e’ ben visibile, sara’ piu’ facile comprenderne il significato; anche per te stesso quando lo riguarderai tra 1 mese.

C) Andando all’efficienza del codice
lo vedi che applichi due volte il colore a ogni cella che compili?

Codice: Seleziona tutto

            'IMPOSTAZIONI PER COLORE CELLA E FONT 5na
AA             Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1).Interior.Color = Range("BQ3").Cells(A, 1).Interior.Color
BB             Color5a = Cells(Rba, 69).Interior.Color
CC             Font5na = Cells(Rba, 69).Font.Color
            'COLORE SOLO CELLA 5na
DD             Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1).Interior.Color = Color5a
            'COLORE SOLO CARATTERE 5na
EE             Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1).Font.Color = Font5na


Le righe AA e DD fanno la stessa cosa; inoltre sia la riga AA che BB vanno a leggere dalla cella BQx il codice colore, operazione intrinsecamente lenta.
Fortunatamente il Font.Color lo assegni una sola volta.

Dal punto di vista dell’efficienza, inoltre, non ha senso che per ogni cella leggi il codice colore del Font e della cella; ti bastera’ farlo una sola volta quando cambi riga e poi usare il valore memorizzato.
Come pure, assegnare il colore a 1 cella o a 5 celle per il vba e’ quasi lo stesso sforzo. Quindi potra’ essere vantaggioso formattare tutta la riga, non cella dopo cella.

Come pure non ha senso che le colonne CONC e DATA vengano scritte 11 volte, a inizio del ciclo For B = 1 To 11.

Cio’ detto il ciclo di cui abbiamo parlato potrebbe diventare

Codice: Seleziona tutto

For A = LBound(Matrice, 1) To UBound(Matrice, 1)
    Rba = 3 'Contatore Per Colore Celle e Font 5ne
    'SCRIVE IL CONCORSO IN B:B(end) OK VA BENE
    Range(Init5na).Offset((A - 1) * 11, -2).Resize(11, 1) = Matrice(A, 1)
    'SCRIVE LA DATA IN C:C(end) OK VA BENE
    Range(Init5na).Offset((A - 1) * 11, -1).Resize(11, 1) = Matrice(A, 2)
    For B = 1 To 11
        Color5a = Cells(Rba, 69).Interior.Color
        Font5na = Cells(Rba, 69).Font.Color
        For C = 1 To 5
            'SCRIVE LA 5na IN D2:H(end) OK VA BENE
             Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1) = Matrice(A, (B - 1) * 5 + C + 2)
        Next C
        'Applica formattazione alla 5na:
        Range(Init5na).Offset((A - 1) * 11 + (B - 1), 0).Resize(1, 5).Interior.Color = Color5a
        Range(Init5na).Offset((A - 1) * 11 + (B - 1), 0).Resize(1, 5).Font.Color = Font5na
        Rba = Rba + 1 'Contatore Per Colore Celle e Font 5ne
    Next B
    Rba = Rba + 1 'Contatore Per Colore Celle e Font 5ne
Next A

Stesso discorso per la compilazione delle variabili iNteColor e iNteFont all’interno del ciclo Do /Loop: inutile compilarle N volte, basta farlo una volta prim del ciclo. Cioe’

Codice: Seleziona tutto

LeRuote = Array("BA", "CA", "FI", "GE", "MI", "NA", "PA", "RM", "TO", "VE", "RN")
B = 0

iNteColor = Cells(2, 69).Interior.Color
iNteFont = Cells(2, 69).Font.Color
Do
    B = B + 1
    If Range(Init5na).Offset((B - 1) * 11, 0) = "" Then Exit Do
    'SCRIVE LA RUOTA IN COLONNA I:I(end) OK VA BENE
    Range(Init5na).Offset((B - 1) * 11, 5).Resize(11, 1) = Application.WorksheetFunction.Transpose(LeRuote)
    'COLORE CELLA INTESTAZIONE SINGOLA BA(Colonna I:Iend)
    Range(Init5na).Offset((D - 1), 5).Resize(1, 1).Interior.Color = iNteColor
    'COLORE FONT INTESTAZIONE SINGOLA BA(Colonna I:Iend)
    Range(Init5na).Offset((D - 1), 5).Resize(1, 1).Font.Color = iNteFont
    D = D + 11 'Contatore Per Colore Intestazione BA Colonna I:Iend
Loop


Va anche considerato che qualsiasi scrittura sul foglio comporta il suo refresh; pertanto anche lo ScreenUpdating conviene metterlo True solo a fine macro, prima del Msgbox

La macro finale e' diventata (per quanto detto finora):

Codice: Seleziona tutto

Sub Due_CON_Colore_Rete()
Dim Matrice, A As Long, B As Long, C As Long, D As Long
Dim Init5na As String, uLtma As Long, LeRuote
'DIMENSIONE PER COLORE
Dim Color5a As Long, Font5na As Long, Rba As Long, iNteColor As Long, iNteFont As Long
'
Range("B2:I150000").Clear
D = 1 'Contatore Per Colore Intestazione BA Colonna I:Iend
Init5na = "D2" 'Inizio Scrittura 5ne
myTim = Timer
Application.ScreenUpdating = False
uLtma = Cells(Rows.Count, "A").End(xlUp).Row
'uLtma = 1000
Matrice = Range("K2:BO2").Resize(uLtma - 1).Value
For A = LBound(Matrice, 1) To UBound(Matrice, 1)
    Rba = 3 'Contatore Per Colore Celle e Font 5ne
    'SCRIVE IL CONCORSO IN B:B(end) OK VA BENE
    Range(Init5na).Offset((A - 1) * 11, -2).Resize(11, 1) = Matrice(A, 1)
    'SCRIVE LA DATA IN C:C(end) OK VA BENE
    Range(Init5na).Offset((A - 1) * 11, -1).Resize(11, 1) = Matrice(A, 2)
    For B = 1 To 11
        Color5a = Cells(Rba, 69).Interior.Color
        Font5na = Cells(Rba, 69).Font.Color
        For C = 1 To 5
            'SCRIVE LA 5na IN D2:H(end) OK VA BENE
             Range(Init5na).Offset((A - 1) * 11 + (B - 1), C - 1) = Matrice(A, (B - 1) * 5 + C + 2)
        Next C
        'Applica formattazione alla 5na:
        Range(Init5na).Offset((A - 1) * 11 + (B - 1), 0).Resize(1, 5).Interior.Color = Color5a
        Range(Init5na).Offset((A - 1) * 11 + (B - 1), 0).Resize(1, 5).Font.Color = Font5na
        Rba = Rba + 1 'Contatore Per Colore Celle e Font 5ne
    Next B
    Rba = Rba + 1 'Contatore Per Colore Celle e Font 5ne
Next A
'
'Application.ScreenUpdating = True
LeRuote = Array("BA", "CA", "FI", "GE", "MI", "NA", "PA", "RM", "TO", "VE", "RN")
B = 0
'
iNteColor = Cells(2, 69).Interior.Color
iNteFont = Cells(2, 69).Font.Color
Do
    B = B + 1
    If Range(Init5na).Offset((B - 1) * 11, 0) = "" Then Exit Do
    'SCRIVE LA RUOTA IN COLONNA I:I(end) OK VA BENE
    Range(Init5na).Offset((B - 1) * 11, 5).Resize(11, 1) = Application.WorksheetFunction.Transpose(LeRuote)
    'COLORE CELLA INTESTAZIONE SINGOLA BA(Colonna I:Iend)
    Range(Init5na).Offset((D - 1), 5).Resize(1, 1).Interior.Color = iNteColor
    'COLORE FONT INTESTAZIONE SINGOLA BA(Colonna I:Iend)
    Range(Init5na).Offset((D - 1), 5).Resize(1, 1).Font.Color = iNteFont
    D = D + 11 'Contatore Per Colore Intestazione BA Colonna I:Iend
Loop
Application.ScreenUpdating = True
MsgBox ("Completato, sec: " & Format(Timer - myTim, "0.00"))
End Sub

A spanne, con questi suggerimenti, io ho visto qualche ulteriore velocizzazione.

Ciao

[ikwae]

Gentilissimo Anthony …. La prima cosa che ho fatto è stato di mandare in esecuzione la tua macro e, in verità,è molto più veloce rispetto alla mia. Sicuramente, certamente e anche scontato che doveva essere così.

Anche se ho a memoria il tuto link di come vanno dichiarate le dimensioni ma una cosa è il teorico e un’altra capire la natura delle Dim (Integer, long, stringa, ecc.) e poi dichiararle con la giusta dimensione.A proposito il tuo secondo link https://docs.microsoft.com/it-it/office ... statement a me da errore.

Poi riguardo al listato l’ho volutamente lascito a ventaglio per evidenziare bene cosa fa ogni riga di codice.
Lo so che si perde tempo, in lettura, tra una riga e l’altra perché il compilatore deve percorrere più righe ma l’ho, come
ho detto sopra, distaccato, per una migliore lettura.

Poi riguardo lo sfarfallio dello schermo anche qui copia&incolla di qualcosa vicino se lo ha portato dietro erroneamente.

Per quanto riguarda l’efficienza del codice per adesso non so dirti nulla di immediato se non lo leggo e lo confronto e forse capisco (si spera) le tue spiegazioni con le modifiche eseguite.

Intanto che confronto, ti vorrei chiedere, una semplice macro per l’aggiornamento e mi spiego meglio.
Finito di generare l’archivio colorato, viene copiato in un’altra posizione all’interno di un’alta macro per dare il suo contributo lavorativo.

Quindi per l’aggiornamento si copiano a mano le ultime estrazioni dalla lotteria e si accodano a quelli colorati.
Avremo il lungo archivio colorato con le ultime 11 righe non colorate e, mandando in esecuzione la macro di aiuto che cerco, dovrebbe colorare le ultime 11 righe prendendo il colore delle 11 righe precedenti compresa la ruota di BA cella (gialla e Font rosso).

Spero di essere stato chiaro ma allego lo stesso un file con un foglio Demo_1 per dare maggiori indicazioni.
Ringraziandoti per il lavoro e i preziosi consigli, da verificare con cura nel dettaglio. Cordialmente ikwae

http://www.filedropper.com/archiviodaor ... oratorete2

[Anthony47]

Il link giusto per Option Explicit:
https://docs.microsoft.com/it-it/office ... -statement
(c’era finita in coda una parentesi, l'ho corretto)

ScreenUpdating non si porta dietro solo l’eventuale sfarfallio ma tutto il tempo necessario a Excel per presentare come foglio di lavoro i dati di volta in volta modificati.

Le righe aggiunte o vuote non sono un problema, perche’ in ogni caso la sub viene “compilata” prima di essere eseguita (non e’ “interpretata” run time). Quello che sottolineavo era come evidenziare la leggibilita' del codice, capire al volo dove finisce un blocco e ne comincia un altro, chi e’ figlio di chi, e così via.

Quanto alla nuova richiesta (formattare i dati accodati), dovrebbe funzionare questa macro:

Codice: Seleziona tutto

Sub FormatUpdates()
Dim LastD As Long, I As Long
'
Range("D2:I12").Copy
LastD = Cells(Rows.Count, "D").End(xlUp).Row

For I = LastD - 10 To 2 Step -11
    If Cells(I, "D").Interior.Color = xlNone Or _
       Cells(I, "D").Interior.Color = RGB(255, 255, 255) Then
        Cells(I, "D").PasteSpecial xlPasteFormats
    Else
        Exit For
    End If
Next I
Application.CutCopyMode = False
End Sub


Ciao

[ikwae]

Gentilissimo Anthony …. Quello che scrivi è Vangelo da tenere presente in ogni situazione ma io ho dei tabù sono personali e non “cedibili”. Una e Option Explicit perché quando assemblo parti di codice o tento di modificare macro non mie, l’80% del lavoro è eliminare le fastidiose gialle causati da errori e sapendo come lavora e cosa fa Option Explicit ti posso
assicurare che non aiuta molto.

L’altra è .Resize(x,y), molto semplice e molto utile da usare MA! è quello che precede il punto che
è odioso ossia “interpretare” da quale cella iniziale inizia il Resize. Prima del punto è arabo scritto in cinese e quindi da evitarlo nelle mie casarecce oppure scartare macro con righe di codice che lo contengono.Questo lo dico a proposito del colore a ognuna cella anziché a tutta la cinquina.

Qui mi vengono in mente

“L’informazione è importane ma è più importante come usi questa informazione” (Confucio)
“Usa quello che hai se riesci a capirlo e soprattutto se riesci ad applicarlo” (ikwae)

Detto questo non è una scusante a non usare le tue preziosissime indicazioni lo dico perché ancora sono carente di esperienza.
Aggiungo queste mie affermazioni non sono da considerare come negazione alle tue preziose e insindacabili indicazioni.

Riguardo alla chiarezza si effettivamente è meglio indentare il codice. Io uso, impropriamente, PilotEdit copio il listato e lui mette i tratteggi di collegamento e io poi tramite il cursore faccio “combaciare” i tratteggi.Lo avrò usato due volte in tutta la mia “attività” hobbistica Exceliana.

Riguardo alla tua ultima macro per il colorare i dati accodati è molto utile e colora tutta le cinquine partendo da D2 ma purtroppo è colpa mia che ho scritto aggiornare l’archivio e non ho sottolineato la parte che recita “prendendo il colore delle 11 righe precedenti”.
Il motivo di queste righe è per il fatto che se io prendo come riferimento un tempo di 18 estrazioni con un colore e poi cambio colore per fare altre 18 estrazioni devo avere i responsi dei due tempi con colori diversi e la tua macro “unifica” tutti i colori rendendoli tutti uguali.
Ripeto è colpa mia perché non mi sono spiegato bene sottolineando la parte.

Io avevo già “assemblato” una macro esattamente come la cercavo e aspettavo la tua proposta di macro per modificare o vedere come imposti la ripetizione del ciclo di 11 volte verso l’alto.
Gentilmente ti chiedo se puoi correggere la mia inserendo dei cicli oppure scrivere una nuova ma tenendo presente che le 11 cinquine di aggiornamento dovrebbero avere lo stesso colore delle 11 righe soprastanti.

Ringraziandoti mille e mille volte sia per le preziose indicazioni e per tutto il resto. Cordialmente ikwae

Codice: Seleziona tutto

'Option Explicit
Sub DaOrizintale_a_Verticale_Aggiornamento_Rete()
'
Dim ultimariga, ultimarigaBA As Long
Dim BaiNtsCell, BaiNtsFon, BaCel, BaFon As Long
Dim CaCel, CaFon, FiCel, FiFon, GeCel, GeFon As Long
Dim MiCel, MiFon, NaCel, NaFon, PaCel, PaFon As Long
Dim RmCel, RmFon, ToCel, ToFon, VeCel, VeFon, RnCel, RnFon As Long
Dim myTim
 '
 myTim = Timer
Application.ScreenUpdating = False
Sheets("Demo").Select
'
ultimariga = Cells(Rows.Count, "D").End(xlUp).Row
ultimarigaBA = Cells(Rows.Count, "I").End(xlUp).Row

'BA INTESTAZIONE CELLA E FONT COLONNA I
   BaiNtsCell = Range("I" & ultimarigaBA - 21).Interior.Color
   BaiNtsFon = Range("I" & ultimarigaBA - 21).Font.Color
   Range("I" & ultimarigaBA).Offset(0 - 10).Interior.Color = BaiNtsCell
   Range("I" & ultimarigaBA).Offset(0 - 10).Font.Color = BaiNtsFon
'BA COLORE CELLA E FONT 5na
   BaCel = Range("D" & ultimariga - 21).Interior.Color
   BaFon = Range("D" & ultimariga - 21).Font.Color
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 10).Interior.Color = BaCel
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 10).Font.Color = BaFon
'CA COLORE CELLA E FONT 5na
   CaCel = Range("D" & ultimariga - 20).Interior.Color
   CaFon = Range("D" & ultimariga - 20).Font.Color
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 9).Interior.Color = CaCel
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 9).Font.Color = CaFon
'FI COLORE CELLA E FONT 5na
   FiCel = Range("D" & ultimariga - 19).Interior.Color
   FiFon = Range("D" & ultimariga - 19).Font.Color
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 8).Interior.Color = FiCel
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 8).Font.Color = FiFon
'GE COLORE CELLA E FONT 5na
   GeCel = Range("D" & ultimariga - 18).Interior.Color
   GeFon = Range("D" & ultimariga - 18).Font.Color
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 7).Interior.Color = GeCel
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 7).Font.Color = GeFon
'MI COLORE CELLA E FONT 5na
   MiCel = Range("D" & ultimariga - 17).Interior.Color
   MiFon = Range("D" & ultimariga - 17).Font.Color
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 6).Interior.Color = MiCel
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 6).Font.Color = MiFon
'NA COLORE CELLA E FONT 5na
   NaCel = Range("D" & ultimariga - 16).Interior.Color
   NaFon = Range("D" & ultimariga - 16).Font.Color
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 5).Interior.Color = NaCel
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 5).Font.Color = NaFon
'PA COLORE CELLA E FONT 5na
   PaCel = Range("D" & ultimariga - 15).Interior.Color
   PaFon = Range("D" & ultimariga - 15).Font.Color
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 4).Interior.Color = PaCel
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 4).Font.Color = PaFon
'RM COLORE CELLA E FONT 5na
   RmCel = Range("D" & ultimariga - 14).Interior.Color
   RmFon = Range("D" & ultimariga - 14).Font.Color
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 3).Interior.Color = RmCel
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 3).Font.Color = RmFon
'TO COLORE CELLA E FONT 5na
   ToCel = Range("D" & ultimariga - 13).Interior.Color
   ToFon = Range("D" & ultimariga - 13).Font.Color
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 2).Interior.Color = ToCel
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 2).Font.Color = ToFon
'VE COLORE CELLA E FONT 5na
   VeCel = Range("D" & ultimariga - 12).Interior.Color
   VeFon = Range("D" & ultimariga - 12).Font.Color
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 1).Interior.Color = VeCel
   Range("D" & ultimariga, "H" & ultimariga).Offset(0 - 1).Font.Color = VeFon
'RN COLORE CELLA E FONT 5na
   RnCel = Range("D" & ultimariga - 11).Interior.Color
   RnFon = Range("D" & ultimariga - 11).Font.Color
   Range("D" & ultimariga, "H" & ultimariga).Interior.Color = RnCel
   Range("D" & ultimariga, "H" & ultimariga).Font.Color = RnFon
     
Application.ScreenUpdating = True
MsgBox ("Completato, sec: " & Format(Timer - myTim, "0.0"))
End Sub

[Anthony47]

Allora:

Codice: Seleziona tutto

Sub FormatUpdates()
Dim LastBa As Long, I As Long
'
LastBa = Evaluate("max((I1:I100000=""BA"")*Row(I1:I100000))")
For I = LastBa To 1 Step -11
    'Cerca ultimo gruppo colorato:
    If Cells(I, "I").Interior.Color <> xlNone And Cells(I, "I").Interior.Color <> RGB(255, 255, 255) Then Exit For
Next I
If I < 5 Then
    MsgBox ("Nessun gruppo colorato? Procedura abortita")
    Exit Sub
End If
'Copia il gruppo:
Cells(I, "D").Resize(11, 6).Copy
For I = I To LastBa - 1 Step 11
    'Colora i gruppi sottostanti:
    Cells(I + 11, "D").PasteSpecial xlPasteFormats
Next I
Application.CutCopyMode = False
End Sub


Ciao

[ikwae]

Gentilissimo Anthony... Ti ringrazio di cuore di tutto il tuo lavoro e soprattutto di quello che in questo thread mi hai insegnato.
Cordialmente ikwae