Formattare celle con motivo

Hai un problema con Excel?

Nuova discussione

Formattare celle con motivo
di ssayan79 data: 16/02/2015 12:39:34
Salve a tutti

avrei bisogno di formattare delle celle con motivo a seconda che in un'altra cella, di controllo, ci sia "yes" o "no".

in più, visto che la cella di controllo potrebbe anche prendere due righe, vorrei poter discriminare il caso in cui la cella di controllo prenda due righe, e quindi formattare entrambe le righe, oppure ne prenda una.

Ho provato a realizzare un codice utilizzando la registrazione delle macro, ma non funziona.

Grazie

Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range("N11:N100")) Is Nothing Then Exit Sub

If Target.Value = "MXX" Then
Cells(Target.Row, 6).Interior.ColorIndex = 38
Cells(Target.Row, 8).Interior.ColorIndex = 38
Cells(Target.Row, 10).Interior.ColorIndex = 38
Cells(Target.Row, 12).Interior.ColorIndex = 38
Cells(Target.Row, 14).Interior.ColorIndex = 38


ElseIf Target.Value = "M6" Then
Cells(Target.Row, 6).Interior.ColorIndex = 40
Cells(Target.Row, 8).Interior.ColorIndex = 40
Cells(Target.Row, 10).Interior.ColorIndex = 40
Cells(Target.Row, 12).Interior.ColorIndex = 40
Cells(Target.Row, 14).Interior.ColorIndex = 40


End If

If Intersect(Target, Range("V11:V100")) Is Nothing Then Exit Sub
If Target.Value = "NO" Then
Cells(Target.Row, 4).Pattern = xlLightUp
Cells(Target.Row, 4).PatternColorIndex = xlAutomatic
Cells(Target.Row, 4).ColorIndex = xlAutomatic
Cells(Target.Row, 4).TintAndShade = 0
Cells(Target.Row, 4).PatternTintAndShade = 0
End If

End Sub

di Vecchio Frac data: 16/02/2015 15:08:10
Ragiona sul codice.
Anzitutto stai lavorando a livello di Workbook: è necesasrio? il codice dovrà funzionare su più fogli? se la risposta è no, non c'è motivo di metterelo nel Workbook, spostalo nel foglio interessato. Se sì, meglio gestire i riferimenti al foglio ("sh" è stato passato apposta, sfruttiamolo).

Poi, tu vuoi intercettare il cambiamento del valore di una cella compresa in due intervalli diversi (N11:N100 e V11:V100); se in una cella tra N11:N100 si inserisce "MXX" oppure "M6" il colore di alcune celle della stessa riga viene modificato; e infine se in una cella tra V11 e V100 si inserisce "NO" allora il pattern della colonna D, riga in cui si trova il cursore, viene modificato.

Solo che... se *non* modifichi una cella tra N11 e N100, cosa fa il tuo codice?
cosa fa la riga iniziale?
If Intersect(Target, Range("N11:N100")) Is Nothing Then Exit Sub

Rileggi, rifletti, e ne riparliamo.
E riscriviamo il codice... il registratore produce schifezze ;)
di ssayan79 data: 17/02/2015 21:40:11
Ciao Vecchio Frac
innanzitutto grazie per la risposta.
Non è strettamente necessario che io lavori su più fogli, quindi in questo caso posso anche lavorare solo sul foglio 1.
Per quanto riguarda le azioni da farsi quando non si specifica niente nelle celle N11:N100 e V11:V100 in realtà adesso il codice dovrebbe funzionare non facendo niente quando non si inserisce una scelta.
Adesso in realtà la scelta avviene attraverso lo strumento dati di convalida da elenco, e questo non è inserito su tutte le celle da N11:N100 e V11:V100, ma solo su alcune di esse.
Spero di essere stato chiaro.
.
di Vecchio Frac data: 17/02/2015 22:15:22
Le mie domande non erano per sapere cosa dovrebbe fare il codice, ma per farti vedere cosa fa... un invito a leggere il codice e a tradurlo per farti capire così che non fa quel che ti aspetti :)
Quindi prima di postarti una soluzione coerente con le tue aspettative, vorrei che capissi da solo perché il tuo script non fa quel che ti aspetti che facesse... e ti ripeto la domanda che ti ho fatto:

"... se *non* modifichi una cella tra N11 e N100, cosa fa il tuo codice?
cosa fa la riga iniziale?
If Intersect(Target, Range("N11:N100")) Is Nothing Then Exit Sub "

di ssayan79 data: 19/02/2015 10:46:00
Ciao vecchio Frac

se una cella tra N11 e N110 non viene modificata, l'intersezione tra la cella modificata (Target) e una delle celle tra N11 e N100 non si verifica (Is Nothing), allora si esce dalla routine e anche dalle istruzioni.

Quello che forse non ho spiegato chiaramente è che il codice esegue correttamente la prima parte. Quello che non funziona è la parte postata sotto.

Grazie mille.

If Intersect(Target, Range("V11:V100")) Is Nothing Then Exit Sub
If Target.Value = "NO" Then
Cells(Target.Row, 4).Pattern = xlLightUp
Cells(Target.Row, 4).PatternColorIndex = xlAutomatic
Cells(Target.Row, 4).ColorIndex = xlAutomatic
Cells(Target.Row, 4).TintAndShade = 0
Cells(Target.Row, 4).PatternTintAndShade = 0
End If

di Vecchio Frac data: 19/02/2015 10:53:50
Dai che ci avviciniamo! :o)
E' quello che ti ho invitato a ripensare chiedendoti di capire cosa fa la prima riga di codice.
Hai risposto:
"se una cella tra N11 e N110 non viene modificata, l'intersezione tra la cella modificata (Target) e una delle celle tra N11 e N100 non si verifica (Is Nothing), allora si esce dalla routine e anche dalle istruzioni. "

Se si esce dalle istruzioni, quindi, dopo aver verificato il target nella prima parte, accade che la seconda parte *non* verrà mai eseguita nè controllata :o)
Ti posto la soluzione finale o vuoi provarci da solo?

di ssayan79 data: 20/02/2015 12:57:29
Ciao vecchio Frac

ho voluto provare io con il codice seguente, ma adesso mi dice che il metodo non e'è supportato dall'oggetto evidenziando la riga
Cells(Target.Row, 4).Pattern = xlLightUp

Dove sto sbagliando ora?

Grazie mille ancora

Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range("N11:N100")) Is Nothing Then
GoTo 10

If Target.Value = "MXX" Then
Cells(Target.Row, 6).Interior.ColorIndex = 38
Cells(Target.Row, 8).Interior.ColorIndex = 38
Cells(Target.Row, 10).Interior.ColorIndex = 38
Cells(Target.Row, 12).Interior.ColorIndex = 38
Cells(Target.Row, 14).Interior.ColorIndex = 38


ElseIf Target.Value = "M6" Then
Cells(Target.Row, 6).Interior.ColorIndex = 40
Cells(Target.Row, 8).Interior.ColorIndex = 40
Cells(Target.Row, 10).Interior.ColorIndex = 40
Cells(Target.Row, 12).Interior.ColorIndex = 40
Cells(Target.Row, 14).Interior.ColorIndex = 40
End If


10:
If Intersect(Target, Range("V11:V100")) Is Nothing Then Exit Sub

If Target.Value = "NO" Then
Cells(Target.Row, 4).Pattern = xlLightUp
Cells(Target.Row, 4).PatternColorIndex = xlAutomatic
Cells(Target.Row, 4).ColorIndex = xlAutomatic
Cells(Target.Row, 4).TintAndShade = 0
Cells(Target.Row, 4).PatternTintAndShade = 0
End If


End If


End Sub

di Vecchio Frac data: 20/02/2015 13:28:35
Già, lo avevo verificato pure io testando il tuo codice :o)
E' solo un errore di sintassi.
Il metodo "Pattern" non si riferisce direttamente a un oggetto range (Cells() restituisce un oggetto range), ma si riferisce a una sua proprietà (di un oggetto range intendo) che è "Interior".

Quindi la sintassi corretta (vale anche per le istruzioni successive) è
Cells(Target.Row, 4).Interior.Pattern = xlLightUp

Ora il tuo codice è concettualmente giusto, è quel "Goto 10" che non voglio vedere, è il retaggio di un vecchio modo di programmare in GWBASIC :o)

Bravo comunque, sono contento che ti sei applicato.

di ssayan79 data: 21/02/2015 09:11:27
Ciao Vecchio Frac

io ho risolto così.
Come elimino il GoTo?

In più ho il problema descritto nella figura allegata quando la cella del "NO" comprende due righe anzichè una.
Come faccio a discriminare i due casi?

Grazie.

Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range("N11:N100")) Is Nothing Then
GoTo 10

If Target.Value = "MXX" Then
Cells(Target.Row, 6).Interior.ColorIndex = 38
Cells(Target.Row, 8).Interior.ColorIndex = 38
Cells(Target.Row, 10).Interior.ColorIndex = 38
Cells(Target.Row, 12).Interior.ColorIndex = 38
Cells(Target.Row, 14).Interior.ColorIndex = 38


ElseIf Target.Value = "M6" Then
Cells(Target.Row, 6).Interior.ColorIndex = 40
Cells(Target.Row, 8).Interior.ColorIndex = 40
Cells(Target.Row, 10).Interior.ColorIndex = 40
Cells(Target.Row, 12).Interior.ColorIndex = 40
Cells(Target.Row, 14).Interior.ColorIndex = 40
End If


10:
If Intersect(Target, Range("V11:V100")) Is Nothing Then Exit Sub

If Target.Value = "NO" Then
Range(Cells(Target.Row, 24), Cells(Target.Row, 26)).Interior.Pattern = xlLightUp
Range(Cells(Target.Row, 24), Cells(Target.Row, 26)).Interior.PatternColorIndex = xlAutomatic
Range(Cells(Target.Row, 24), Cells(Target.Row, 26)).Interior.ColorIndex = xlAutomatic
Range(Cells(Target.Row, 24), Cells(Target.Row, 26)).Interior.TintAndShade = 0
Range(Cells(Target.Row, 24), Cells(Target.Row, 26)).Interior.PatternTintAndShade = 0



ElseIf Target.Value = "YES" Then
Range(Cells(Target.Row, 24), Cells(Target.Row, 26)).Interior.Pattern = xlNone
Range(Cells(Target.Row, 24), Cells(Target.Row, 26)).Interior.PatternColorIndex = xlNone
Range(Cells(Target.Row, 24), Cells(Target.Row, 26)).Interior.ColorIndex = xlNone
Range(Cells(Target.Row, 24), Cells(Target.Row, 26)).Interior.TintAndShade = 0
Range(Cells(Target.Row, 24), Cells(Target.Row, 26)).Interior.PatternTintAndShade = 0

End If

End If


End Sub

di Vecchio Frac data: 21/02/2015 11:30:58
cit. "Come faccio a discriminare i due casi? "
---> Non lo so... non hai detto che risultato ti aspetti ^_^

Perfetto! Così funziona.
Ma si può migliorare, per renderlo più leggibile e manutenibile anche in futuro.
Ti allego la mia versione del tuo codice; io elimino il Goto con una cascata di If...Elseif...Else...Then...End If
Provalo e rivedilo per imparare qualche trucco nuovo :o)

Poi parleremo della modifica per venire incontro alla nuova esigenza della cella unita che si riferisce a due righe, di cui prima non avevi parlato.

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer

    If Not Intersect(Target, Range("N11:N100")) Is Nothing Then
        If UCase(Target.Value) = "MXX" Then
            For i = 6 To 14 Step 2
                Cells(Target.Row, i).Interior.ColorIndex = 38
            Next
        ElseIf UCase(Target.Value) = "M6" Then
            For i = 6 To 14 Step 2
                Cells(Target.Row, i).Interior.ColorIndex = 40
            Next
        Else
            For i = 6 To 14 Step 2
                Cells(Target.Row, i).Interior.ColorIndex = -4142
            Next
        End If
        
    ElseIf Not Intersect(Target, Range("V11:V100")) Is Nothing Then
        If UCase(Target.Value) = "NO" Then
            With Cells(Target.Row, 4).Interior
                .Pattern = xlLightUp
                .PatternColorIndex = xlAutomatic
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        Else
            Cells(Target.Row, 4).ClearFormats
        End If
    End If
    
End Sub

di ssayan79 data: 22/02/2015 11:44:31
Ciao Vecchio Frac

il codice funziona, ovviamente.
Avrei bisogno però di alcuni chiarimenti:
1. If Not Intersect(Target, Range("N11:N100")) Is Nothing
significa che c'è intersione?
2. Cells(Target.Row, i).Interior.ColorIndex = -4142
A che serve?

Grazie mille per la tua pazienza.
di Vecchio Frac data: 22/02/2015 13:16:23
1. Lo so, è una doppia negazione e si fa fatica a leggerla. "Not is nothing" vuol dire "non è nullo", cioè "esiste un risultato": se l'indirizzo del target (la cella che si sta modificando) rientra nel range N11:N100 allora ...
Intersect restituisce un oggetto range; se la condizione è soddisfatta (target rientra nel range specificato) allora l'oggetto intersect non è nullo (is not nothing --> not is nothing) e quindi l'esecuzione continua dentro il blocco If.

2. Il valore -4142 corrisponde alla costante xlNone e l'istruzione assegna il colore di sfondo predefinito (trasparente) alla cella; attenzione che il colore *non* è bianco, anche se sembra esserlo. All'atto pratico: se nel range N11:N100 scrivo qualcosa di diverso da M6 e da MMX, tutte le celle alternate che vengono altrimenti colorate, vengono ripristinate al loro colore predefinito (trasparente) con l'effetto visivo che hai notato.
E sì, puoi scrivere xlNone che forse è anche meglio :o)
di ssayan79 data: 22/02/2015 13:48:59
Grazie Vecchio Frac.

Per quanto riguarda il problema del file allegato?
Come potrei risolvere?
Non so se c'è una istruzione al riguardo che possa essere sufficiente, o serve un blocco di codice.

Grazie ancora.
di Vecchio Frac data: 22/02/2015 19:51:03
Non ho capito il problema perchè non hai ancora detto che risultato ti aspetti quando scrivi "NO" in una cella unita che si riferisce a due righe diverse. Qual è il comportamento atteso? spiega l'esempio dell'immagine che hai allegato.
di ssayan79 data: 22/02/2015 22:25:44
Scusa se non sono stato chiaro.
In pratica mi aspetto che quando la riga del "NO" comprenda due sottorighe, queste vengano entrambe ricoperte col pattern.
Adesso succede che viene ricoperta solo quella superiore, come descritto nell'immagine che ho allegato.

Spero di essere stato chiaro stavolta.
Grazie mille.

di Vecchio Frac data: 25/02/2015 10:58:33
Ecco, queste le sono le modifiche.
Avevo tra parentesi dimenticato di disabilitare gli eventi, una cosa che si deve fare sempre quando si pasticcia con gli eventi del foglio... sorry.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer

    Application.EnableEvents = False
    
    If Not Intersect(Target, Range("N11:N100")) Is Nothing Then
        If UCase(Target.Value) = "MXX" Then
            For i = 6 To 14 Step 2
                Cells(Target.Row, i).Interior.ColorIndex = 38   'purple
            Next
        ElseIf UCase(Target.Value) = "M6" Then
            For i = 6 To 14 Step 2
                Cells(Target.Row, i).Interior.ColorIndex = 40   'gold
            Next
        Else
            For i = 6 To 14 Step 2
                Cells(Target.Row, i).Interior.ColorIndex = xlNone
            Next
        End If
        
    ElseIf Not Intersect(Target, Range("V11:V100")) Is Nothing Then
        With Cells(Target.Cells(1).Row, 4)
            If UCase(Target.Cells(1).Value) = "NO" Then
                .Resize(Target.MergeArea.Cells.Count).ClearFormats
                .Resize(Target.MergeArea.Cells.Count).Interior.Pattern = xlLightUp
            Else
                .Resize(Target.Cells.Count).ClearFormats
            End If
        End With
    End If
    
    Application.EnableEvents = True
    
End Sub

di ssayan79 data: 28/02/2015 14:43:12
Grazie Vecchio Frac

volevo capire meglio come funziona il metodo resize.
Potresti indicarmi qualche link dove poter trovare delle spiegazioni utili?

Ciao
di Vecchio Frac data: 28/02/2015 17:24:28
Resize è un metodo di un oggetto Range che ridefinisce l'estensione del range stesso.
I suoi parametri sono riga, colonna; se non specifichi un parametro, avrà valore zero
Activecell.Resize(10, 5) espande la selezione dalla cella attiva per dieci righe a destra e cinque in basso (se activecell è A1 quindi, definisce un nuovo range da A1 a E10).
In combinazione con Offset puoi ridefinire un range e spostarlo.
E' quello che faccio quando voglio esaminare una tabella con intestazione ma saltando l'intestazione: definisco l'area della tabella con CurrentRegion a partire dalla prima cella, mi sposto in giù di una riga, quindi "resizo" la selezione per togliere l'ultima riga (che è vuota dopo l'Offset).
range("A1").CurrentRegion.offset(1).resize(range("A1").currentregion.rows.count-1).Select

Per le info di base su Resize scrivilo in finestra immediata e premi F1 per la guida.

Vuoi Approfondire?