Lampeggio condizionato multiplo

Hai un problema con Excel?

Nuova discussione

Lampeggio condizionato multiplo
di ffante (utente non iscritto) data: 05/01/2015 22:53:44
Buonasera

Ho un foglio in cui avrei bisogno di far lampeggiare le celle "C11,f11,i11,l11" se si verifica la condizione "Semil. esaurito" dal

risultato di una formula al momento in cui inserisco un valore della quantità del fabisogno sulla cella "f27"

cercando di scopiazzare un codice trovato sul vostro sito sono riuscito a far lampeggiare le celle singolarmente.

Nel caso in cui si verifica la condizione che due o più delle quattro celle sopra descritte abbiano "Semil. esaurito" mi lampeggia solo

la prima che ha questa condizione, vi ho inserito il codice, se qualcuno mi puo dare una mano.

If Target.Address(0, 0) = "F27" Then

For Each Cella In Range("C11,F11,I11,L11").Cells

        'If Cella = "Semil. esaurito" Then
        
        If Range("C11") = "Semil. esaurito" Then
        
        Dim PauseTime, Start, Finish

For x = 1 To 5    
PauseTime = 0.3
Start = Timer   
Do While Timer < Start + PauseTime  
DoEvents  
Range("C11").Cells.Interior.ColorIndex = 6  
Loop
Finish = Timer  
PauseTime = 0.3   
Start = Timer   
Do While Timer < Start + PauseTime
DoEvents    
Range("C11").Cells.Interior.ColorIndex = 15
Loop
Finish = Timer 
Next x
                        
ElseIf Range("F11") = "Semil. esaurito" Then
                        
For x = 1 To 5    
PauseTime = 0.3  
Start = Timer   
Do While Timer < Start + PauseTime  
DoEvents  
Range("F11").Cells.Interior.ColorIndex = 6  
Loop
Finish = Timer  
PauseTime = 0.3   
Start = Timer   
Do While Timer < Start + PauseTime
DoEvents    
Range("F11").Cells.Interior.ColorIndex = 15
Loop
Finish = Timer 
Next x
        
ElseIf Range("I11") = "Semil. esaurito" Then
                        
For x = 1 To 5    
PauseTime = 0.3  
Start = Timer   
Do While Timer < Start + PauseTime  
DoEvents  
Range("I11").Cells.Interior.ColorIndex = 6  
Loop
Finish = Timer  
PauseTime = 0.3   
Start = Timer   
Do While Timer < Start + PauseTime
DoEvents    
Range("I11").Cells.Interior.ColorIndex = 15
Loop
Finish = Timer 
Next x

ElseIf Range("L11") = "Semil. esaurito" Then       
                
For x = 1 To 5    
PauseTime = 0.3  
Start = Timer   
Do While Timer < Start + PauseTime  
DoEvents  
Range("L11").Cells.Interior.ColorIndex = 6  
Loop
Finish = Timer  
PauseTime = 0.3   
Start = Timer   
Do While Timer < Start + PauseTime
DoEvents    
Range("L11").Cells.Interior.ColorIndex = 15
Loop
Finish = Timer 
Next x

Range("C11,F11,I11,L11").Cells.Interior.ColorIndex = 15

End
End If
Next Cella

End If
End Sub

di Vecchio Frac data: 06/01/2015 08:54:20
A naso mi sembra tutto, come dire, un po' inutilmente complicato...
E intuisco qualcosa che non va ma ancora non so definire cosa ^_^
Comunque adesso devo aiutare a disfare l'albero, poi guardo più da vicino.
Buona Befana a tutti :)
di Vecchio Frac data: 06/01/2015 09:19:02
Tra una pallina e l'altra, qualche consiglio di stile, al volo:
- manca option explicit (è importante! ma non lo mettono nei libri che consultate?)
- meglio testare Intersect invece che target.address(0, 0) (che è pure illeggibile)
- i dim tutti a inizio codice
- quando hai molto codice ripetitivo, richiamarlo da sub o function separate

di Vecchio Frac data: 06/01/2015 10:42:00
Ecco una versione più compatta, che fa lampeggiare le celle interessate tutte insieme.
Penso che si possa fare meglio (per esempio è fastidioso continuare a vedere il lampeggio se nel frattempo ho già cambiato il valore per eliminare la condizione di semilavorato esaurito).
Però intanto è qualcosa sui cui lavorare :)

Option Explicit

Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range, r As Range

    If Intersect(Target, Range("F27")) Is Nothing Then
        Exit Sub
    End If
    
    Application.EnableEvents = False
    
    For Each cell In Range("C11,F11,I11,L11")
        If cell = "Semil. esaurito" Then
            If Not r Is Nothing Then
                Set r = Union(r, cell)
            Else
                Set r = cell
            End If
        End If
    Next
    If Not r Is Nothing Then blink r
    
    Application.EnableEvents = True
End Sub


Private Sub blink(c As Range)
Dim x As Integer
Dim PauseTime As Single
Dim Start As Single
Dim Finish As Single

    For x = 1 To 5    'inizia il ciclo e lo ripete per 5 volte
        PauseTime = 0.3  ' Imposta la durata in secondi. ho messo 1/2 secondo
        Start = Timer   ' Imposta l'ora di inizio: Timer rappresenta il numero di secondi trascorsi dalla mezzanotte
        Do While Timer < Start + PauseTime  'fino a che il valore di Timer è inferiore al valore reperito con Start più il 'tempo in secondi impostato con PauseTime, continua a contare (Loop)
            DoEvents  'si consente di passare il controllo ad altri processi.(altrimenti il ciclo bloccherebbe altri eventi)
            c.Interior.ColorIndex = 6  'colora il range di celle di Giallo
        Loop
        Finish = Timer  ' Imposta l'ora di fine della pausa.
        PauseTime = 0.3   ' Imposta la durata.
        Start = Timer   ' Imposta l'ora di inizio.
        Do While Timer < Start + PauseTime
            DoEvents    ' Passa il controllo ad altri processi.
            c.Interior.ColorIndex = 15
        Loop
        Finish = Timer ' Imposta l'ora di fine della pausa.
    Next
End Sub

di scossa (utente non iscritto) data: 06/01/2015 11:19:36
cit. Vecchio Frac: "
- manca option explicit (è importante! ma non lo mettono nei libri che consultate?)
- meglio testare Intersect invece che target.address(0, 0) (che è pure illeggibile)
- i dim tutti a inizio codice
- quando hai molto codice ripetitivo, richiamarlo da sub o function separate
"

sono d'accordo su tutto tranne che su
"- meglio testare Intersect invece che target.address(0, 0) (che è pure illeggibile)"

Sarà meno "leggibile" () ma è, in linea di principio, più performante: leggere una proprietà è meno "dispendioso" che non applicare un metodo.

Sottolineo che sto parlando "in linea di principio", ma lo si può verificare praticamente (vedi codice sottostante), anche se la differenza è percepibile solo su una grande mole:

intersect   address
4,76171875  4,046875
4,70703125  3,9921875
4,6953125   3,99609375
4,7109375   3,984375
4,72265625  3,984375

scossa's web site

Se tu hai una mela, ed io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno.
Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

Public Sub prova()
  Dim j As Long
  Dim k As Long
  Dim nStart As Single
  
  Range("C2:C6").ClearContents
  Range("D2:D6").ClearContents
  Application.ScreenUpdating = False
  For k = 2 To 6
    nStart = Timer
    For j = 1 To 40000
      If Not Intersect(Range("A" & j), Range("A" & j)) Is Nothing Then Debug.Print j
    Next j
    Range("C" & k).Value = Timer - nStart
    nStart = Timer
    For j = 1 To 40000
      If Range("B" & j).Address = "$B$" & j Then Debug.Print j
    Next j
    Range("D" & k).Value = Timer - nStart
  Next k
  Application.ScreenUpdating = True
End Sub

di Vecchio Frac data: 06/01/2015 11:31:31
Concordo naturalmente sulle prestazioni.
E' vero, e toglierei pure "in linea di principio"; comunque il consiglio di testare Intersect era finalizzato alla leggibilità per la manutenzione futura, ecco il commento su target.address(0, 0) perchè sicuramente un domani, manutenendo il proprio codice, l'autore si potrebbe chiedere cosa mai sia un indirizzo che punta a una coordinata nulla :)

Nel merito invece (poco tempo, poca voglia, bambini che distraggono, ecc.) non sono riuscito a scrivere un codice decente per far sì che, scrivendo un valore in F27 *durante un lampeggio precedente*, il lampeggio cessi e venga valutato il nuovo inserimento. Ripeto, pigrizia :)

di scossa data: 06/01/2015 11:38:52
cit. Vecchio Frac: "...ecco il commento su target.address(0, 0) perchè sicuramente un domani, manutenendo il proprio codice, l'autore si potrebbe chiedere cosa mai sia un indirizzo che punta a una coordinata nulla"

ATTENZIONE: target.address(0, 0) non "punta a una coordinata nulla" ma semplicemente restituisce l'indirizzo come riferimento relativo (senza $, p.e. "A1") anziché assoluto (default per target.address, p.e. "$A$1")

scossa's web site

di scossa data: 06/01/2015 11:40:51
Ovviamente il mio appunto era riferito agli utenti meno esperti, non certo a Vecchio Frac, che sa benissimo di cosa si parla.

scossa's web site

Lampeggio condizionato multiplo
di ffante (utente non iscritto) data: 06/01/2015 11:47:29
Vecchio Frac ti ringrazio tantissimo del tempo che mi hai dedicato il codice che mi hai inviato l'ho provato e

funziona perfettamente saluti Franco.
Lampeggio condizionato multiplo
di ffante (utente non iscritto) data: 06/01/2015 11:50:10
Vecchio Frac ti ringrazio tantissimo del tempo che mi hai dedicato il codice che mi hai inviato l'ho provato e

funziona perfettamente Franco.

Buona Befana a tutti..

Vuoi Approfondire?