Formula equivalente ma più veloce.

[Statix]

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.

[Anthony47]

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.

[Statix]

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]

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.

[Statix]

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

[Anthony47]

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

[Flash30005]

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

[Statix]

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.

[Anthony47]

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

[Statix]

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]

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.

[Statix]

riporto su la richiesta se è possibile modificare la macro del post precedente,
o una ex nuova,per velocizzarla.
grazie.

[Anthony47]

Il file di test risulta non piu' disponibile, puoi ripubblicarlo?

[Statix]

Ciao Anthony47,
ti allego il file
http://www.filedropper.com/ambata

[Anthony47]

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.

[Statix]

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]

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

[Statix]

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.

[Anthony47]

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

[Statix]

Ciao Anthony47,
entrambe le modifiche sono ok,
grazie di cuore.