Condividi:        

Excel Ottimizare Macro

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Excel Ottimizare Macro

Postdi Statix » 23/05/09 18:01

Ciao a tutti,volevo chiedervi se era possibile ottimizare questa macro con dei cicli For -Next per renderla un pò più veloce se possibile
grazie
Codice: Seleziona tutto
Sub Colore_K()

Application.ScreenUpdating = False

Sheets("K").Select
'1K0 1

For i = 9 To 608
For Each cell In Range("D" & i & ":H" & i)
If cell.Interior.ColorIndex = 3 Then
Range("AG" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'2K0 1

For i = 9 To 608
For Each cell In Range("I" & i & ":M" & i)
If cell.Interior.ColorIndex = 3 Then
Range("AH" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'3K0 1

For i = 9 To 608
For Each cell In Range("N" & i & ":R" & i)
If cell.Interior.ColorIndex = 3 Then
Range("AI" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'4K0 1

For i = 9 To 608
For Each cell In Range("S" & i & ":W" & i)
If cell.Interior.ColorIndex = 3 Then
Range("AJ" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'5K0 1

For i = 9 To 608
For Each cell In Range("X" & i & ":AB" & i)
If cell.Interior.ColorIndex = 3 Then
Range("AK" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'1K0 2

For i = 9 To 608
For Each cell In Range("D" & i & ":H" & i)
If cell.Interior.ColorIndex = 4 Then
Range("AM" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'2K0 2

For i = 9 To 608
For Each cell In Range("I" & i & ":M" & i)
If cell.Interior.ColorIndex = 4 Then
Range("AN" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'3K0 2


For i = 9 To 608
For Each cell In Range("N" & i & ":R" & i)
If cell.Interior.ColorIndex = 4 Then
Range("AO" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'4K0 2
For i = 9 To 608
For Each cell In Range("S" & i & ":W" & i)
If cell.Interior.ColorIndex = 4 Then
Range("AP" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'5K0 2

For i = 9 To 608
For Each cell In Range("X" & i & ":AB" & i)
If cell.Interior.ColorIndex = 4 Then
Range("AQ" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'1K0 3
For i = 9 To 608
For Each cell In Range("D" & i & ":H" & i)
If cell.Interior.ColorIndex = 5 Then
Range("AS" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'2K0 3

For i = 9 To 608
For Each cell In Range("I" & i & ":M" & i)
If cell.Interior.ColorIndex = 5 Then
Range("AT" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'3K0 3

For i = 9 To 608
For Each cell In Range("N" & i & ":R" & i)
If cell.Interior.ColorIndex = 5 Then
Range("AU" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'4K0 3

For i = 9 To 608
For Each cell In Range("S" & i & ":W" & i)
If cell.Interior.ColorIndex = 5 Then
Range("AV" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'5K0 3


For i = 9 To 608
For Each cell In Range("X" & i & ":AB" & i)
If cell.Interior.ColorIndex = 5 Then
Range("AW" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'1K0 4

For i = 9 To 608
For Each cell In Range("D" & i & ":H" & i)
If cell.Interior.ColorIndex = 6 Then
Range("AY" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'2K0 4
For i = 9 To 608
For Each cell In Range("I" & i & ":M" & i)
If cell.Interior.ColorIndex = 6 Then
Range("AZ" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'3K0 4
For i = 9 To 608
For Each cell In Range("N" & i & ":R" & i)
If cell.Interior.ColorIndex = 6 Then
Range("BA" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'4K0 4
For i = 9 To 608
For Each cell In Range("S" & i & ":W" & i)
If cell.Interior.ColorIndex = 6 Then
Range("BB" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'5K0 4

For i = 9 To 608
For Each cell In Range("X" & i & ":AB" & i)
If cell.Interior.ColorIndex = 6 Then
Range("BC" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i

'1K0 5

For i = 9 To 608
For Each cell In Range("D" & i & ":H" & i)
If cell.Interior.ColorIndex = 7 Then
Range("BE" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'2K0 5

For i = 9 To 608
For Each cell In Range("I" & i & ":M" & i)
If cell.Interior.ColorIndex = 7 Then
Range("BF" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'3K0 5
For i = 9 To 608
For Each cell In Range("N" & i & ":R" & i)
If cell.Interior.ColorIndex = 7 Then
Range("BG" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'4K0 5
For i = 9 To 608
For Each cell In Range("S" & i & ":W" & i)
If cell.Interior.ColorIndex = 7 Then
Range("BH" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'5K0 5
For i = 9 To 608
For Each cell In Range("X" & i & ":BA" & i)
If cell.Interior.ColorIndex = 7 Then
Range("BI" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
Application.ScreenUpdating = True
End Sub
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Sponsor
 

Re: Excel Ottimizare Macro

Postdi Anthony47 » 23/05/09 21:06

Secondo me ottieni lo stesso risultato se ogni gruppo e' impostato come
Codice: Seleziona tutto
For Each cell In Range("D9:H608")
If cell.Interior.ColorIndex = 3 Then
Range("AG" & Cell.Row) = Range("AF" & Cell.Row)
Exit For
End If
Next cell

E probabilmente puoi sostituire ogni blocco della macro con
Codice: Seleziona tutto
For JJ=0 to 4
For Each cell In Range("D9").offset(0;JJ*5).Range("A1:E600")
If cell.Interior.ColorIndex = 3 Then
Range("AG" & Cell.Row) = Range("AF" & Cell.Row)
Exit For
End If
Next cell
Next JJ

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Ottimizare Macro

Postdi Statix » 24/05/09 20:55

Ciao Anthony,
le macro suggeritemi,non possono andare,
perchè la ricerca che io faccio si applicano a 5 numeri X 5 Biruote = 25
per questo motivo ho dovuto creare una macro con 25 istruzioni,che trovato il colore, si ricava la posizione,ritardo è ruota.come foto nel post Modifica Macro.
esempio tipo un quadrato 5X5 ,evidenziato un numero nel quadrato,la macro mi deve trovare le coordinate tipo A3,
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Ottimizare Macro

Postdi Anthony47 » 25/05/09 00:45

Qui purtoppo la descrizione data non mi consente i capire cosa dovrebbe fare la macro originale, per proporre qualche altra ipotesi.
Tieni presente che per me un biruota e' una bicicletta o una moto, e sfaldare un verbo che non promette nulla di buono; quindi l' eventuale descrizione data con nomenclatura "lotto" con me non funziona.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Ottimizare Macro

Postdi Statix » 25/05/09 09:15

Ciao Anthony,
per farti capire il meccanismo,ti allego un imagine esempio.
come vedi, con una prima macro mi trovo i 5 numeri evidenziandoli nella tabella,succesivamente utilizzo altre 5 tabelle
per ricavare in che posizione sono usciti,la macro che ho postato fa questo lavoro e funziona bene,io volevo sapere se era possibile ottimizzarla per renderla più veloce.
Immagine
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Ottimizare Macro

Postdi Anthony47 » 27/05/09 01:37

Perdona, ma non riesco a collegare quello che scrivi con la macro postata e le immagini; se il tempo di esecuzione e' gestibile forse la cosa piu' semplice e' tenerti stretta la macro che funziona.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Ottimizare Macro

Postdi Flash30005 » 27/05/09 08:15

Il codice che invio non velocizza la tua macro ma la semplifica nel senso che dovrebbe fare tutto quello che è contenuto nel tuo codice in poche righe utilizzando un For Next
Codice: Seleziona tutto
Sub Colora()
For CC = 4 To 28 Step 5
RCol = 33
Colc = Int((CC + 1) / 5) + 2
For i = 9 To 608
For Each cell In Range(Cells(i, CC), Cells(i, CC + 4))
If cell.Interior.ColorIndex = Colc Then
Cells(i, RCol) = Range("AF" & i)
Exit For
End If
Next cell
Next i
RCol = RCol + 1
Next CC
End Sub

Si potrebbe studiare un tipo di elaborazione più veloce ma per farlo bisognerebbe avere almeno il foglio dei dati e non un'immagine senza riferimenti di colonne e righe.
Un consiglio:
Le tabelle composte da 5 colonne (Rosso, Blu, Verde etc etc,) sulla destra dell'immagine non dovrebbero essere separate tra loro da una colonna per non complicare la realizzazione della macro stessa.
Tutto si fa ma si dovrebbero semplificare le impostazioni iniziali, quando questo è possibile.
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Excel Ottimizare Macro

Postdi Flash30005 » 27/05/09 09:28

Correggo la macro precedente con questa (effettuava solo un ciclo di 5)
ma come esposto non potendo verificare senza i dati posso solo testare se non va in errore comunque prova questa
Codice: Seleziona tutto
Sub Colora()
Rcol = 33
For Rip = 1 To 5
    For CC = 4 To 28 Step 5
        Colc = Int((CC + 1) / 5) + 2
        For i = 9 To 15
            For Each cell In Range(Cells(i, CC), Cells(i, CC + 4))
                If cell.Interior.ColorIndex = Colc Then
                    Cells(i, Rcol) = Range("AF" & i)
                    Exit For
                End If
            Next cell
        Next i
        Rcol = Rcol + 1
        If Rcol = 38 Or Rcol = 44 Or Rcol = 50 Or Rcol = 56 Then Rcol = Rcol + 1
    Next CC
Next Rip
End Sub

Dovrebbe sostituire le 25 macro da te postate.
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Excel Ottimizare Macro

Postdi Statix » 04/06/09 09:10

Ciao a tutti, mi scuso con Flash per non aver risposto prima a questo post,causa, molto impegnato,volevo riproporre di nuovo il quesito di ottimizzare la macro,ho eseguito il consiglio di Anthony
Anthony47 ha scritto:Secondo me ottieni lo stesso risultato se ogni gruppo e' impostato come

Codice: Seleziona tutto
For Each cell In Range("D9:H608")
If cell.Interior.ColorIndex = 3 Then
Range("AG" & Cell.Row) = Range("AF" & Cell.Row)
Exit For

ebbene la modifica effettuata mi ha raddoppiato la velocità di esecuzione,quindi volevo chiedere se è possibile con ulteriore ottimizzazione della macro aumentare la velocità,

Codice: Seleziona tutto
Sub Cerca_Colore()
Application.ScreenUpdating = False
Sheets("Ruote").Select
'Bari


For Each Cell In Range("D9:H508")
If Cell.Interior.ColorIndex = 3 Then
Range("BO" & Cell.Row) = Range("BN" & Cell.Row)

Exit For
End If
Next Cell


'Cagliari

For Each Cell In Range("I9:M508")
If Cell.Interior.ColorIndex = 4 Then
Range("BP" & Cell.Row) = Range("BN" & Cell.Row)
Exit For
End If
Next Cell

'Firenze


For Each Cell In Range("N9:R508")
If Cell.Interior.ColorIndex = 5 Then
Range("BQ" & Cell.Row) = Range("BN" & Cell.Row)
Exit For
End If
Next Cell

'Genova

For Each Cell In Range("S9:W508")
If Cell.Interior.ColorIndex = 6 Then
Range("BR" & Cell.Row) = Range("BN" & Cell.Row)
Exit For
End If
Next Cell

'Milano

For Each Cell In Range("X9:AB508")
If Cell.Interior.ColorIndex = 7 Then
Range("BS" & Cell.Row) = Range("BN" & Cell.Row)
Exit For
End If
Next Cell

'Napoli

For Each Cell In Range("AC9:AG508")
If Cell.Interior.ColorIndex = 8 Then
Range("BT" & Cell.Row) = Range("BN" & Cell.Row)
Exit For
End If
Next Cell


'Palermo

For Each Cell In Range("AH9:AL508")
If Cell.Interior.ColorIndex = 9 Then
Range("BU" & Cell.Row) = Range("BN" & Cell.Row)
Exit For
End If
Next Cell

'Roma

For Each Cell In Range("AM9:AQ508")
If Cell.Interior.ColorIndex = 10 Then
Range("BV" & Cell.Row) = Range("BN" & Cell.Row)
Exit For
End If
Next Cell

'Torino

For Each Cell In Range("AR9:AV508")
If Cell.Interior.ColorIndex = 11 Then
Range("BW" & Cell.Row) = Range("BN" & Cell.Row)
Exit For
End If
Next Cell

'Venezia

For Each Cell In Range("AW9:BA508")
If Cell.Interior.ColorIndex = 12 Then
Range("BX" & Cell.Row) = Range("BN" & Cell.Row)
Exit For
End If
Next Cell
Application.ScreenUpdating = True
Range("A1").Select
End Sub

come si evince dalla macro ogni ruota ha un colore ed un range diverso ma consecutivi
allego la tabella dove è applicata la macro
Immagine
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Ottimizare Macro

Postdi Anthony47 » 04/06/09 15:52

Secondo me, dal punto di vistra della velocita' di esecuzione del codice non puoi fare molto di piu'; potresti rendere piu' elegante la macro inserendo un solo blocco in un ciclo For I=1 to 11 (le ruote) e calcolando il range da "lavorare" in base a I; ma questo peggiorerebbe seppur di pochissimo il tempo di esecuzione.

Nell' ipotesi che il tuo file includa formule con funzioni volatili o molta formattazione condizionale puoi provare a inserire in testa Application.Calculation = xlManual e in coda Application.Calculation = xlCalculationAutomatic.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Ottimizare Macro

Postdi luca2002for » 26/06/09 20:42

Anthony47 ha scritto:Tieni presente che per me un biruota e' una bicicletta o una moto, e sfaldare un verbo che non promette nulla di buono; quindi l' eventuale descrizione data con nomenclatura "lotto" con me non funziona.


Senza offesa per Statix, ma stavo leggendo quà e là le problematiche varie su excel e ho trovato questa risposta di
Anthony....volevo solo dire che ho riso per mezz'ora sulla cosa della biruota e di sfaldare :lol:

Anthony sei un mito :)
luca2002for
Utente Senior
 
Post: 116
Iscritto il: 07/05/06 09:32

Re: Excel Ottimizare Macro

Postdi Flash30005 » 28/06/09 18:19

luca2002for ha scritto:... stavo leggendo quà e là le problematiche varie su excel e ho trovato questa risposta di
Anthony....volevo solo dire che ho riso per mezz'ora sulla cosa della biruota e di sfaldare :lol:

Anthony sei un mito :)


Conoscendo come la pensa Anthony sui ritardi, frequenze etc ho riso molto anche io :lol:

Invece non ho avuto riscontro da Statix in merito all'uso (se l'ha fatto) della macro da me postata il 27 maggio ore 10:28
che replico qui
Codice: Seleziona tutto
Sub Colora()
Rcol = 33
For Rip = 1 To 5
    For CC = 4 To 28 Step 5
        Colc = Int((CC + 1) / 5) + 2
        For i = 9 To 15
            For Each cell In Range(Cells(i, CC), Cells(i, CC + 4))
                If cell.Interior.ColorIndex = Colc Then
                    Cells(i, Rcol) = Range("AF" & i)
                    Exit For
                End If
            Next cell
        Next i
        Rcol = Rcol + 1
        If Rcol = 38 Or Rcol = 44 Or Rcol = 50 Or Rcol = 56 Then Rcol = Rcol + 1
    Next CC
Next Rip
End Sub

Visto che vorrebbe velocizzare l'ultima macro che sta usando
Statix ha scritto:...ebbene la modifica effettuata mi ha raddoppiato la velocità di esecuzione,quindi volevo chiedere se è possibile con ulteriore ottimizzazione della macro aumentare la velocità...

Del resto solo Statix possedendo i fogli già impostati può effettuare il test per verificare sia il funzionamento che la velocità di esecuzione che ad oggi non abbiamo avuto alcun feedback.

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-


Torna a Applicazioni Office Windows


Topic correlati a "Excel Ottimizare Macro":


Chi c’è in linea

Visitano il forum: Nessuno e 37 ospiti

cron