Formattazione condizionale per matrice

Hai un problema con Excel?

Nuova discussione

Formattazione condizionale per matrice
di Sbizzy data: 18/12/2014 16:24:12
Ciao a tutti,

ho un file excel (in allegato) composto da una tabella di 15 colonne x 80 righe. Come si vede dalla colonna B, tale tabella è composta da 16 matrici di 15 colonne x 5 righe. Il contenuto di ognuna delle prime 4 righe delle matrici è irrilevante (sono codici, numeri e date prese da un file esterno), mentre la 5° riga è modificabile con dei valori prestabiliti. In base a tali valori, le 4 celle corrispondenti alla medesima colonna della stessa matrice, si devono colorare con la seguente logica (nel file ho messo alcuni esempi per le prime tre matrici, ma il concetto è da estendere a tutta la tabella):

1_cella vuota = celle bianche
2_testo che inizia con il numero 1 = celle verdi
3_testo che inizia con il numero 2 = celle gialle
4_scritta OK = celle blu
5_altre scritte (che non siano OK o inizino per 1 o 2) = celle rosse

Io sono riuscito a trovare le 4 regole (la cella vuota non conta) che soddisfino le richieste, ma valgono solo per la prima delle 16 matrici, il che significa che dovrei replicarle altre 15 volte fino a creare un totale di 80 regole di formattazione condizionale! Visto che tali regole a volte variano, è possibile creare solo 4 formule in modo che valgano per tutte le matrici?

Grazie in anticipo, ciao!

di Albatros54 (utente non iscritto) data: 23/12/2014 18:58:51
Ho adattato il codice alla formattazione del foglio1, sembra che funzioni.
ti posto il codice, incollalo in un modulo VBA, e lo puoi associare ad un pulsante.

Public Sub Albatros54()
    Dim sh As Worksheet
    With ThisWorkbook
        Set sh = ThisWorkbook.Worksheets("Foglio1")
        Set Rng = Names("uno").RefersToRange
        Set rng1 = Names("due").RefersToRange
        Set rng2 = Names("tre").RefersToRange
        Set bigrange = Application.Union(Rng, rng1, rng2)


    End With

    With sh


        For Each cl In bigrange



            If Left(cl, 1) = 1 Then
                For a = 1 To 4
                    cl.Select
                    cl.Offset(-a, 0).Activate
                    Selection.Cells.Interior.ColorIndex = 10
                Next

            ElseIf Left(cl, 1) = 2 Then
                For a = 1 To 4
                    cl.Select
                    ActiveCell.Offset(-a, 0).Activate
                    Selection.Cells.Interior.ColorIndex = 6
                Next
            ElseIf UCase(Left(cl, 2)) = "OK" Then

                For a = 1 To 4
                    cl.Select
                    ActiveCell.Offset(-a, 0).Activate
                    Selection.Cells.Interior.ColorIndex = 41
                Next
            ElseIf cl = "" Then
                For a = 1 To 4
                    cl.Select
                    ActiveCell.Offset(-a, 0).Activate
                    Selection.Cells.Interior.ColorIndex = 2
                    Next
                Else
                    For a = 1 To 4
                        cl.Select
                        ActiveCell.Offset(-a, 0).Activate
                        Selection.Cells.Interior.ColorIndex = 3
                    Next
                    End If
                
            Next
        End With
    End Sub

di Sbizzy data: 26/12/2014 18:15:55
Ciao,
grazie della risposta, proverò a farlo appena rientro al lavoro poi ti farò sapere!

di Albatros54 (utente non iscritto) data: 28/12/2014 13:32:22
Cosi forse va meglio.
Ciao
Albatros54

Option Compare Text



Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    With ThisWorkbook
        Set Sh = ThisWorkbook.Worksheets("Foglio1")
        Set Rng = Names("uno").RefersToRange    '"Uno" è il nome dato al Range(c5:q5)
        Set rng1 = Names("due").RefersToRange    '"due" è il nome dato al Range(c10:q10)
        Set rng2 = Names("tre").RefersToRange    '"tre" è il nome dato al Range(c15:q15)
        Set bigrange = Application.Union(Rng, rng1, rng2)    'ho unito i vari Range in una matrice


    End With
    Application.ScreenUpdating = False
    With Sh


        For Each cl In bigrange



            If (cl Like "1*") = True Then   
                For a = 1 To 4
                    cl.Select
                    cl.Offset(-a, 0).Activate
                    Selection.Cells.Interior.ColorIndex = 10
                Next

            ElseIf (cl Like "2*") = True Then    
                For a = 1 To 4
                    cl.Select
                    ActiveCell.Offset(-a, 0).Activate
                    Selection.Cells.Interior.ColorIndex = 6
                Next
            ElseIf (cl Like "ok") = True Then   
                For a = 1 To 4
                    cl.Select
                    ActiveCell.Offset(-a, 0).Activate
                    Selection.Cells.Interior.ColorIndex = 41
                Next
            ElseIf cl = "" Then
                For a = 1 To 4
                    cl.Select
                    ActiveCell.Offset(-a, 0).Activate
                    Selection.Cells.Interior.ColorIndex = 2
                Next
            Else
                For a = 1 To 4
                    cl.Select
                    ActiveCell.Offset(-a, 0).Activate
                    Selection.Cells.Interior.ColorIndex = 3
                Next
            End If

        Next

    End With
    Application.ScreenUpdating = True
End Sub

di Zer0Kelvin data: 28/12/2014 16:39:16
Salve a tutti.
Premetto che non posso vedere il file in quanto dopo alcuni giorni gli allegati vengono eliminati dal forum, ma non mi è chiaro il motivo per cui si cerchi di utilizzare una macro per realizzare quanto richiesto nel quesito.
Una volta realizzate le quattro regole di formattazione condizionale, non c'è necessità di crearne altre; è sufficiente copiare i formati con Copia->Incolla formato.
Tra l'altro credo che la macro (un gestore di eventi, in realtà) sia un tantino da rivedere.
di Albatros54 (utente non iscritto) data: 28/12/2014 18:14:19
Se ci sono dei miglioramenti da apportare ben vengano!!
siamo qua per IMPARARE.
Ciao
albatros54
di Sbizzy data: 08/01/2015 15:21:40
Ciao,

dopo un po' di tentativi, ho fatto funzionare la macro (quella in automatico). Ho fatto un piccola modifica perchè nel file originale ci sono anche le celle con 0 e devono rimanere bianche (diventavano rosse).
Per il resto tutto ok, tranne una piccola cosa: il file originale non ha i bordi sottili a separare le celle, ma solo quelli spessi a separare le tabelle. Quando la macro gira, le celle colorate nascondono la griglia. Se ci fosse un modo per evitare questo guaio, sarebbe l'ideale perchè vorrei evitare di mettere i bordi.

Comunque già questo è un ottimo risultato, grazie mille. Ciao.
di Albatros54 (utente non iscritto) data: 09/01/2015 18:51:09

di Sbizzy data: 12/01/2015 11:02:06
Alla fine ho risolto mettendo questa parte di codice per le celle bianche:

 ElseIf cl = "" Or cl = 0 Then
                For a = 1 To 4
                    cl.Select
                    ActiveCell.Offset(-a, 0).Activate
                     With Selection.Interior
                      .Pattern = xlNone
                      .TintAndShade = 0
                      .PatternTintAndShade = 0
                     End With
                    Next

Vuoi Approfondire?