LAMPEGGIO IN CONTEMPORANEAMENTE

[BOLDOS75Partecipante BOLDOS75]

Buongiorno, chiedo un aiuto per un mio problema.

Uso MSOP 2021, nel file che allego se possibile, dalla riga A2 a L6 ho delle voci che cambiano nelle varie celle.

Con il mio codice mi lampeggiano le celle in cui ho le scritte diverse, prima la riga 2 poi la riga 4 e poi la riga 6, ma a me servirebbe  che mi lampeggiassero tutte contemporaneamente.

Ringrazio per la collaborazione

 

 

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 247 pts]

Le tre routine di lampeggiamento (blink*) sono chiamate sequenzialmente, quindi e' un comportamento normale per come e' scritto il codice. Andrebbe riscritto in modo diverso: se posso suggerire, non creare un range diverso per il primo gruppo, uno per il secondo e uno per il terzo, bensi' un range solo che contenga le celle che rispondono al criterio di "lampeggiamento". La routine di blink, a quel punto una sola, accende e spegne il range omnicomprensivo.

La tua idea e' ottima e infatti funziona, ma devi applicarla a un range piu' vasto, che comprenda tutte le celle interessate.

A margine annoto che faccio gran fatica a leggere il tuo codice, ma questa e' questione di stile e di abitudine su cui non si puo' intervenire 🙂

[vecchio fracSenior Moderator vecchio frac Karma: 247 pts]

Vedi se questo codice ti soddisfa.

Option Explicit

Sub test()
Dim r As Range
Dim cell As Range
Dim g(1) As Range
Dim v As Variant
Dim i As Integer
Dim j As Integer

    Set r = Range("A2:L6")
    v = Array(Array("VERO", "ALTA", "DESTRA"), Array("FALSO", "BASSA", "SINISTRA"))

    For j = 0 To 1
        For Each cell In r
            If cell.Text <> "" Then
                For i = 0 To 2
                    If cell.Text = v(j)(i) Then
                        If g(j) Is Nothing Then
                            Set g(j) = cell
                        Else
                            Set g(j) = Union(g(j), cell)
                        End If
                    End If
                Next
             End If
        Next
    Next
    
    'blinking
    Call blink(g)
    
End Sub


Private Sub blink(r)
Dim y As Integer
Dim PauseTime As Single
Dim Finish As Single
Dim c As Range
Dim col1 As Object
Dim v As Variant

    Set col1 = CreateObject("Scripting.Dictionary")
    
    'memorizza colori originali
    For Each c In r(0)
        col1.Add c.Address, Array(c.Interior.ColorIndex, c.Font.ColorIndex)
    Next
    
    PauseTime = 0.3
    For y = 1 To 5
        Finish = Timer + PauseTime
        Do While Timer < Finish
            DoEvents
            With r(0)
                .Interior.ColorIndex = 6
                .Font.ColorIndex = 1
            End With
        Loop
        Finish = Timer + PauseTime
        Do While Timer < Finish
            DoEvents
            With r(0)
                .Interior.ColorIndex = 3  ' 3=ROSSO
                .Font.ColorIndex = 2  '2=BIANCO
            End With
        Loop
    Next
    
    'ripristina colori originali
    For Each v In col1
        With Range(v)
            .Interior.ColorIndex = col1(v)(0)
            .Font.ColorIndex = col1(v)(1)
        End With
    Next
    
    Set col1 = Nothing

End Sub

Edit: annientato l'oggetto Dizionario. Per i puristi 🙂

[Raffaele53Partecipante Raffaele53 Karma: 13 pts]

@vecchio frac
Ieri stavo vedendo il problema e mi sono reso conto che mancava un "qualcosa" d'importante (a parte If Intersect(Target, Range("A10:B16")) ....Exit Sub)
1) Qual'è la condizione che deve far scattare vero/falso
2) Idem per alta/bassa
3) Idem per destra/sinistra
4) Worksheet_SelectionChange
Dato che non ha spiegato queste condizioni (meglio aspettare altre info), a Lui si accendeva la sequenza Falso,Alta,Destra a Te Vero,Alta,Destra.
La domanda, mà a cosa serve questo file?

[vecchio fracSenior Moderator vecchio frac Karma: 247 pts]

Infatti non sono chiari i criteri del lampeggiamento percio' mi sono limitato al codice (la sequenza nel mio codice e' definita nell'array di array "v" e per semplificare ho attivato solo la sequenza del primo array, se ho confuso vero con falso la modifica e' facile).

Non ho modificato l'evento SelectionChange per dar modo di testare una routine separata, ma questo e' irrilevante.

Raffaele53 ha scritto:

La domanda, mà a cosa serve questo file?

Questo lo sa solo lui, se interviene ce lo facciamo spiegare   

[BOLDOS75Partecipante BOLDOS75]

Buongiorno, mi deve lampeggiare solo quando ho scritto (FALSO  quando finisce il lampeggio  deve colorarsi come la cella B10 ,ALTA quando finisce il lampeggio  deve colorarsi come B12,  SINISTRA quando finisce il lampeggio  deve colorarsi come B14). Invece quando ho scritto (VERO,BASSA,DESTRA) si devono colorare rispettivamente come B10,B12,B14.   Ho aggiunto io     Sub Worksheet_Change(ByVal Target As Range). I colori originali sono dalla cella A10:B14

Se volessi modificare i colori della cella esempio  E14 che comando devo aggiungere  a

Interior.ColorIndex = 
.Font.ColorIndex = 

Spero di essermi spiegato e non aver fatto confusione.

Grazie mille.

allego il file

Allegati:

You must be logged in to view attached files.

[Raffaele53Partecipante Raffaele53 Karma: 13 pts]

OK, le celle lampeggiano quando scrivi FALSO....
Mà in quale cella scrivi=FALSO, una cella definita oppure una qualsiasi?

>>> i colori della cella esempio E14
Sub E14()
Range("E14").Interior.ColorIndex = 4
Range("E14").Font.ColorIndex = 1
End Sub

>>>I colori originali sono dalla cella A10:B14
Pertanto i colori in B4 sono errati?
Sub B4()
Range("B4").Interior.ColorIndex = 44
Range("B4").Font.ColorIndex = 1
End Sub

[BOLDOS75Partecipante BOLDOS75]

Scrivo in una qualsiasi da A2:L6

[vecchio fracSenior Moderator vecchio frac Karma: 247 pts]

Quindi l'obiettivo e' far lampeggiare le celle di A2:L6 che corrispondono al valore inserito in una cella del medesimo intervallo? Per esempio: se in G4 inserisci "VERO", tutte le celle dell'intervallo che contengono VERO lampeggiano e poi tornano del colore definito dalla cella in A10:B14 che contiene VERO.

Is this correct?   

[BOLDOS75Partecipante BOLDOS75]

si proprio cosi

 

[BOLDOS75Partecipante BOLDOS75]

scusa dovrebbero lampeggiare solo le celle che contengono le parole in B10:B14 le altre parole in A10:A14 non devono lampeggiare i colori devono essere come in A10B14

[vecchio fracSenior Moderator vecchio frac Karma: 247 pts]

BOLDOS75 ha scritto:

si proprio cosi

Bene. Allora ti propongo queste modifiche.

Option Explicit

Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim cell As Range
Dim g As Range
Dim i As Integer
Dim j As Integer

    If Target.Cells.Count > 1 Then Target = Target.Cells(1, 1)
    If Target = "" Then Exit Sub
    If Intersect(Target, Range("A2:L2,A4:L4,A6:L6")) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
    Set r = Range("A2:L2,A4:L4,A6:L6")

    For Each cell In r
        If cell.Text <> "" And cell.Text = Target.Text Then
            If g Is Nothing Then Set g = cell Else Set g = Union(g, cell)
        End If
    Next
    
    'blinking
    Call blink(g)
    
    Application.EnableEvents = True
    
End Sub


Private Sub blink(r)
Dim y As Integer
Dim PauseTime As Single
Dim Finish As Single
Dim c As Range
Dim v As Variant
Dim oColl As New Collection

    With oColl
        .Add "B10", "FALSO"
        .Add "B12", "ALTA"
        .Add "B14", "SINISTRA"
        .Add "A10", "VERO"
        .Add "A12", "BASSA"
        .Add "A14", "DESTRA"
    End With
    
    PauseTime = 0.3
    For y = 1 To 5
        Finish = Timer + PauseTime
        Do While Timer < Finish
            DoEvents
            With r
                .Interior.ColorIndex = 6
                .Font.ColorIndex = 1
            End With
        Loop
        Finish = Timer + PauseTime
        Do While Timer < Finish
            DoEvents
            With r
                .Interior.ColorIndex = 3  ' 3=ROSSO
                .Font.ColorIndex = 2  '2=BIANCO
            End With
        Loop
    Next
    
    'ripristina colori originali
    For Each v In r
        With Range(v.Address)
            .Interior.ColorIndex = Range(oColl(v.Text)).Interior.ColorIndex
            .Font.ColorIndex = Range(oColl(v.Text)).Font.ColorIndex
        End With
    Next

    Set oColl = Nothing

End Sub

Il ripristino dei colori originali non e' perfetto... dipende dalla palette di colori in uso. Preferirei farti utilizzare Color invece che ColorIndex.

[vecchio fracSenior Moderator vecchio frac Karma: 247 pts]

BOLDOS75 ha scritto:

dovrebbero lampeggiare solo le celle che contengono le parole in B10:B14 le altre parole in A10:A14 non devono lampeggiare

C on la versione che ho proposto, quando modifichi una cella e inserisci uno dei sei valori accettati, tutte le celle che contengono quel valore lampeggiano. Se le parole da accettare sono di meno, basta adeguare il codice del corpo principale, quando si fanno i controlli sul Target, per esempio con If Target <> "BASSA" Then Exit Sub

[BOLDOS75Partecipante BOLDOS75]

Buongiorno, il codice funziona, mi sono dimenticato che dovrei collegarlo alle  celle di confronto esempio: =D10>5000 allora scrivi FALSO nella riga 2 B2  , =D10<5000 allora scrivi VERO nella riga 2 A1

=D12>5000 allora scrivi ALTA nella riga 4 B4 , =D12<5000 allora scrivi BASSA nella riga 4 A4

=D14>5000 allora scrivi DESTRA nella riga 6 B6 , =D14<5000 allora scrivi SINISTRA nella riga 6 A6

le celle che devono lampeggiare 

Grazie mille per la pazienza.

[Raffaele53Partecipante Raffaele53 Karma: 13 pts]

>>>Scrivo in una qualsiasi da A2:L6
Tutto questo casino, perchè non siamo in grado di spiegare per bene il problema.
Domanda e se fosse 5000 esatto? Sicuro che scrivi Tu manualmente in D10,D12,D14 oppure è una formula?

PS. Mà a cosa serve questo files?

' subito sotto Dim j As Integer
If Not Intersect(Target, Range("D10,D12,D14")) Is Nothing Then
    If Range("D10") < 5000 Then Range("B2") = "VERO"
    If Range("D10") > 5000 Then Range("A2") = "FALSO"
    If Range("D12") < 5000 Then Range("B4") = "ALTA"
    If Range("D12") > 5000 Then Range("A4") = "BASSA"
    If Range("D14") < 5000 Then Range("B6") = "SINISTRA"
    If Range("D14") > 5000 Then Range("A6") = "DESTRA"
''''''''''''
'''''''''''' e prima di END sub
End If

[BOLDOS75Partecipante BOLDOS75]

Sto creando un file, per fare dei confronti tra fogli con diversi valori tra loro, con i preziosi suggerimenti sono riuscito a crearlo e adattandolo con la tua preziosa  risposta #45063 ,mi manca solo per completare il tutto he quando trova :

("FALSO" o "ALTA" o "SINISTRA") esca un messaggio tipo ATTENZIONE ANOMALIA

e quando esce ("VERO" o "BASSA" o "DESTRA") esca un messaggio tipo TUTTO OK

dopo questo ultimo aiuto spero di aver concluso.

Grazie mille 

[Autore]

Articoli