Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Formula equivalente ma più veloce.

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

Re: Formula equivalente ma più veloce.

Postdi Statix » 10/06/13 00:42

Ciao Anthony47,
visto l'ora credo che incomincio a confondermi,
eventualmente ricontrollo tutto domani mattina ,
puo darsi che stò sbagliando qualcosa.
buonanotte e grazie.
PS forse la formula è giusta e ho qualche altro problema,
a parte la modifica che mi servirà in seguito.
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Sponsor
 

Re: Formula equivalente ma più veloce.

Postdi Anthony47 » 10/06/13 00:43

Penultimissima ipotesi:
Codice: Seleziona tutto
Cells(6 + I, "DU").FormulaLocal = "=SE(O($L" & (6 + I) & ">=$I$4;L" & (6 + I) & "="""");"""";SE(CONTA.SE(D" & (6 + I) & ":H" & (6 + I) & ";$A$2)=1;$L" & (6 + I) & ";""""))"

Da rivedere a mentre fresca, vale anche per me.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13904
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Formula equivalente ma più veloce.

Postdi Statix » 10/06/13 13:22

Ciao Anthony47,
stamattina ho provato ed è tutto ok,
risolto anche il problema delle ultime righe che non venivano scritte,mancava una condizione ad una formula.
un ultimo piacere da chiederti ,
ho parte delle formule che dovrebbero essere scritte dalla riga 4690 all'ultima (UR)
tipo questa,che incominciano dalla riga 6

Codice: Seleziona tutto
Cells(6 + I, "DU").FormulaLocal = "=SE(O($L" & (6 + I) & ">=$I$4;L" & (6 + I) & "="""");"""";SE(CONTA.SE(D" & (6 + I) & ":H" & (6 + I) & ";$A$2)=1;$L" & (6 + I) & ";""""))"


credo che si dovrebbe creare un nuovo 'array.
e modificare le formule sostituire il 6 Cells(6+I) con Cells(4690+I)
ed anche gli altri 6.
nel frattempo vedo se riesco.
graziedi tutto. ;) ;)
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Formula equivalente ma più veloce.

Postdi Statix » 10/06/13 14:01

e vai c'è lo fatta,
dall'inizio ho perso molto tempo,
in quanto non ho mai usato gli array,
ma poco per volta stò imparando.
ringrazio Anthony47,ricky53 e Flash 30005,
sono degli ottimi maestri.
:lol: :lol:
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Formula equivalente ma più veloce.

Postdi Statix » 10/06/13 14:19

Ciliegina sulla torta,
si può adattare anche questa macro con una formula da mettere nel array?
in colonna P
questa formula restituisce il valore della colonna A se c'è una cella o più celle di colore verde nel range(D6:H6)

Codice: Seleziona tutto
For I = 6 To Urs
For Each cell In Range("D" & I & ":H" & I)

If cell.Interior.ColorIndex = 4 Then
Range("P" & I) = Range("A" & I)

End If
Next cell
Next I
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Formula equivalente ma più veloce.

Postdi Anthony47 » 11/06/13 14:13

Non e' possibile caricare rapidamente in un array i dati della formattazione cella; quindi quel ciclo rimane cosi' come l' hai scritto (l' alternativa e' che usi quel ciclo per caricare nella matrice il colorindex di ogni cella, e poi usi il contenuto della matrice, ma il vantaggio di questa doppia fase e' ovviamente negativo).

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13904
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Formula equivalente ma più veloce.

Postdi Flash30005 » 11/06/13 15:52

Potresti usare questa macro
Codice: Seleziona tutto
    For I = 6 To Urs
        Tr = 0
        For CC = 4 To 8
            If Cells(I, CC).Interior.ColorIndex = 4 Then Tr = 1
        Next CC
        If Tr = 1 Then Range("P" & I) = Range("A" & I)
    Next I


ciao
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Formula equivalente ma più veloce.

Postdi Statix » 11/06/13 22:49

Ciao Flash30005,
ho provato la macro , ho gli stessi tempi della prima.
dovrò optare per qualcosa di nuovo, spero che mi venga qualche idea,
in realtà io uso una tua macro che mi colora dei numeri al primo evento dopo l'uscita di un numero spia,
una tua macro e adattata da Anthony47 anni fa.
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Formula equivalente ma più veloce.

Postdi Anthony47 » 11/06/13 23:10

In effetti il ciclo suggerito da Flash non aveva chance di essere piu' veloce di quello originariamente proposto da Statix.
In particolare lo svantaggio e' nell' usare un ciclo standard For CC = 4 to 8 /Next C rispetto a un ciclo For Each Item InCollection /Next Item: infatti essendo la collezione una delle strutture dati di excel la sua gestione e' ottimizzata rispetto a un loop standard.
In un test di performance, la macro originale ha impiegato 0.56 secondi, la variante 0,62.
Se proprio vogliamo quindi limare qualche microsecondo bisogna eliminare, nella macro di Statix, anche il ciclo For I = 6 To URS /Next I, optando per un unico For Each /Next:
Codice: Seleziona tutto
For Each cell In Range("D6:H" & URS)
    If cell.Interior.ColorIndex = 4 Then
        Range("R" & cell.Row) = Range("A" & cell.Row)
    End If
Next cell
Il tempo di esecuzione del test di performance e' stato di 0,45 sec; statisticamente si tratta di una riduzione del -20%, anche se immagino che non ti cambiera' la vita.

Ciao a tutti
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13904
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Formula equivalente ma più veloce.

Postdi Statix » 12/06/13 08:19

Ciao Anthony47,
ciao Flash30005,
secondo me si dovrebbe cercare di modificare questa macro per renderla un pò più veloce.
il foglio per il test lo postato precedentemente.
la macro trova un numero spia (VALN) tot volte (NV) e lo colora di rosso,
dopo aver colorato la spia in rosso va a trovare il primo evento dopo la spia in rosso i numeri del range D2:F2
e li colora di verde che poi con l'ultima macro postata da Anthony 47(colore)va a scrivere
il record (colonna A) di riga (valore in colonna R)

Codice: Seleziona tutto
Sub NumeroE()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


   
Urs = [A4]
NV = [B4]
'[D3:F3].ClearContents
Range("D6:H" & Urs).Interior.ColorIndex = 0
ValN = [A2]
Vr = 0
For I = 0 To 350
For J = 0 To 5
Vett(I, J) = 0
Next J
Next I
Vett(0, 0) = 6
For RR = Urs To 6 Step -1
    For CC = 4 To 8
        If Cells(RR, CC).Value = ValN Then
       
        Cells(RR, CC).Interior.ColorIndex = 3
        Vr = Vr + 1
        Vett(Vr, 0) = RR
        If NV = Vr Then GoTo salta
        End If
    Next CC
Next RR
salta:
    ' J5Vett = [A2]
       ' FlDue = 0
       
        For I = [B4] To 1 Step -1
        FlDue = 0
       
       
            For J = Vett(I, 0) + 1 To Urs
            FlUno = 0
                For K = 4 To 0 Step -1
                    For L = 0 To [G1] - 1
                    Cells(J, 4 + K).Select
                    If Cells(J, 4 + K) = Cells(2, 4 + L) Then
                      Cells(J, 4 + K).Interior.ColorIndex = 4
                      FlUno = 1:
                      Vett(I, L + 1) = Vett(I, L + 1) + 1
                    End If
                    Next L

                Next K
                If FlUno > 0 Then FlDue = FlDue + 1
                If FlDue >= 1 Then GoTo NextRng
            Next J
NextRng:
        Next I
   
      '  For L = 0 To [G1] - 1
          '  For I = Range("B4").Value To 1 Step -1
               ' Cells(3, 4 + L) = Cells(3, 4 + L) + Vett(I, L + 1)
            'Next I
        'Next L

Call colore
        End Sub
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Formula equivalente ma più veloce.

Postdi Statix » 12/06/13 08:38

Per quanto riguarda la macro,
servirebbe solo il record del primo evento dopo la spia in rosso,
per il colore non mi interessa,in quanto fu una mia idea di anni fa per ricavare il record.
un esempio
se la spia 2 esce alla 3456
e un numero o due del range (D2:F2) esce alla 3467,
e un secondo numero del range (D2:F2) esce alla 3489,
a me interessa solo il primo record 3467 in colonna R,
cioè il primo evento.
Immagine
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Formula equivalente ma più veloce.

Postdi Statix » 15/06/13 10:14

riporto su la richiesta se è possibile modificare la macro del post precedente,
o una ex nuova,per velocizzarla.
grazie.
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Formula equivalente ma più veloce.

Postdi Anthony47 » 16/06/13 12:20

Il file di test risulta non piu' disponibile, puoi ripubblicarlo?
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13904
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Formula equivalente ma più veloce.

Postdi Statix » 16/06/13 13:55

Ciao Anthony47,
ti allego il file
http://www.filedropper.com/ambata
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Formula equivalente ma più veloce.

Postdi Anthony47 » 17/06/13 00:43

Non sono entrato nei dettagli della tua Sub NumeroE, ma questa mi pare una versione "analoga" che pero' sfrutta un array in cui vengono copiati inizialmente A1:Hxxx, sicche' non ci saranno ulteriori accessi alla struttura excel per conoscere i valori di quelle celle; ho inoltre eliminato una ".Select" inutile e ho modificato un ciclo da For J = Vett(I, 0) + 1 To Urs a For J = Vett(I, 0) + 1 To Vett(I - 1, 0)
Le celle eliminate sono precedure da '>>>>, quelle aggiunte sono seguite da '<<<<
I tempi di esecuzione sono abbastanza piu' rapidi della versione originale; il risultato mi sembra analogo.
Codice: Seleziona tutto
Option Base 0
Public Urs, Vett(400, 10), Vr, ValN, NV As Integer
Dim myVARR              '<<<<

Sub NumeroEVAnt()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


myTim = Timer
   
Urs = [A4]
NV = [B4]
'[D3:F3].ClearContents
Range("D6:H" & Urs).Interior.ColorIndex = 0
ValN = [A2]

Range("P6").Resize(Urs, 1).ClearContents    '<<<<
myVARR = Range("A1:H" & Urs).Value          '<<<<



Vr = 0
For I = 0 To [B2]
For J = 0 To 5
Vett(I, J) = 0
Next J
Next I
Vett(0, 0) = 6
For RR = Urs To 6 Step -1
    For CC = 4 To 8
        If myVARR(RR, CC) = ValN Then       '<<<
'>>>        If Cells(RR, CC).Value = ValN Then
       
        Cells(RR, CC).Interior.ColorIndex = 3
        Vr = Vr + 1
        Vett(Vr, 0) = RR
        If NV = Vr Then GoTo salta
        End If
    Next CC
Next RR
salta:
    ' J5Vett = [A2]
        FlDue = 0
       
        For I = [B4] To 1 Step -1
        FlDue = 0
       
            For J = Vett(I, 0) + 1 To Vett(I - 1, 0) ' <<<<<  ERA To Urs
            FlUno = 0
                For K = 4 To 0 Step -1
                    For l = 0 To [G1] - 1
'>>>                    Cells(J, 4 + K).Select
'>>>                    If Cells(J, 4 + K) = Cells(2, 4 + L) Then
                       
                    If myVARR(J, 4 + K) = myVARR(2, 4 + l) Then '<<<
                      Cells(J, 4 + K).Interior.ColorIndex = 4
                      Cells(J, "P").Value = Cells(J, "A").Value  '<<<<
                      FlUno = 1:
                      Vett(I, l + 1) = Vett(I, l + 1) + 1
                    End If
                    Next l

                Next K
                If FlUno > 0 Then FlDue = FlDue + 1
                If FlDue >= 1 Then GoTo NextRng
            Next J
NextRng:
        Next I
   
        'For L = 0 To [G1] - 1
            'For I = Range("B4").Value To 1 Step -1
                'Cells(3, 4 + L) = Cells(3, 4 + L) + Vett(I, L + 1)
            'Next I
        'Next L

'>>>>> Call Colore
     
  Application.Calculation = xlCalculationAutomatic
Calculate
Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox (Timer - myTim)

        End Sub


La Sub Colore non e' piu' richiamata, perche' il suo lavoro e' fatto all' interno del ciclo For l = 0 To [G1] - 1; il msgbox finale puo' essere eliminato.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13904
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Formula equivalente ma più veloce.

Postdi Statix » 17/06/13 07:57

Ciao Anthony47,
ho provato la macro funziona bene,
ma non riesce a coprire le ultime 100 estrazioni in basso
non evidenzia ne i numeri successivi alla spia che il record.,
questo potrebbe dipendere dalla conta del numeri spia ,
vedo nel frattempo se riesco a sistemare.
per il momento ti ringrazio moltissimo.
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Formula equivalente ma più veloce.

Postdi Statix » 17/06/13 08:27

come vedi in questa immagine non mi ha coperto il numero 3,
a volte capita che non copre altri numeri sempre dopo la spia in rosso,
quindi è quella in verde che non va del tutto
è qui che non va ,ho rimesso Urs funziona ma i tempi si sono allungati di circa 3 secondi

Codice: Seleziona tutto
For J = Vett(I, 0) + 1 To Urs 'Vett(I - 1, 0) ' <<<<<  ERA To Urs

Immagine
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Formula equivalente ma più veloce.

Postdi Statix » 17/06/13 10:35

ho un altro problema ,per il rifacimento della schermata
ho spostato il range D2:F2
in L4:N4
ho corretto
Codice: Seleziona tutto
If myVARR(J, 4 + K) = myVARR(4, 12 + L) Then '<<<

mi da un errore ,forse bisogna modificare ancora qualcosa altro,
ci sto provando.
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Formula equivalente ma più veloce.

Postdi Anthony47 » 17/06/13 12:05

Per lo spostamento in L4:N4 dovresti modificare
Codice: Seleziona tutto
myVARR = Range("A1:N" & Urs).Value          '<<<<
'. . .
If myVARR(J, 4 + K) = myVARR(2, 12 + l) Then '<<<

Per il problema segnalato stamattina:
Ripristina il ciclo For J = Vett(I, 0) + 1 To Urs , poi aggiungi l' istruzione marcta '<<<<** subito dopo; cioe':
Codice: Seleziona tutto
            For J = Vett(I, 0) + 1 To Urs 
            If I > 1 And J > Vett(I - 1, 0) Then Exit For     '<<<<**

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13904
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Formula equivalente ma più veloce.

Postdi Statix » 17/06/13 12:45

Ciao Anthony47,
entrambe le modifiche sono ok,
grazie di cuore.
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "Formula equivalente ma più veloce.":


Chi c’è in linea

Visitano il forum: patel e 4 ospiti