macro colora celle

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Ciao a tutti.

girando in rete ho trovato questa macro che dovrebbe colorare le celle di un determinato range di colonne L/M/N/O

Non mi funziona, non colora le celle penso che sia sbagliato qui:

color = RGB(0, 176, 240) '<<<<<

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    Dim letter As String
    Dim color As Long
        
    Set rng = Me.Range("L8:L3000,M8:M3000,N8:N3000,O8:O3000")
  
    If Not Intersect(Target, rng) Is Nothing Then
                     
        Select Case Target.Column
            Case 12 ' Column L
                letter = "P"
                color = RGB(0, 176, 240)
                '.Interior.color = vbBlue
            Case 13 ' Column M
                letter = "D"
                color = RGB(255, 204, 0)
            Case 14 ' Column N
                letter = "C"
                color = RGB(255, 0, 0)
            Case 15 ' Column O
                letter = "A"
                color = RGB(0, 255, 0)
            Case Else
                Exit Sub
        End Select
               
    End If
End Sub

 

 

[scossaPartecipante scossa Karma: 37 pts]

Ciao,

- hai dichiarato la variabile color come Long (Dim color As Long);

- hai assegnato alla variabile color un valore (p.e. color = RGB(255, 204, 0));

però la variabile color non la vedo utilizzata in nessun punto del codice, quindi ...... 

 

 

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Tutta sballata....

Un aiuto per correggere?

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Avevo questa macro, ma è un pò lunga

Option Explicit

  
Private Sub Worksheet_Change(ByVal Target As Range)
     
Dim Rng, Rng2, rCell As Range
        
'-------------------------------------------------------------
'lettere colorate

Set Rng = Range("L8:L5000") '<<=== da CAMBIARE
Set Rng2 = Intersect(Rng, Target)
If Not Rng2 Is Nothing Then
For Each rCell In Rng2.Cells
With rCell
Select Case LCase(.Value)
Case Is = "p", "P"
.Interior.Color = RGB(0, 176, 240)
Case Else
'.Interior.ColorIndex = xlNone '<<< nessun colore
End Select
End With
Next rCell
End If
    
    
Set Rng = Range("M8:M5000") '<<=== da CAMBIARE
Set Rng2 = Intersect(Rng, Target)
If Not Rng2 Is Nothing Then
For Each rCell In Rng2.Cells
With rCell
Select Case LCase(.Value)
Case Is = "d", "D"
.Interior.Color = RGB(255, 204, 0)
Case Else
'.Interior.ColorIndex = xlNone '<<< nessun colore
End Select
End With
Next rCell
End If

Set Rng = Range("N8:N5000") '<<=== da CAMBIARE
Set Rng2 = Intersect(Rng, Target)
If Not Rng2 Is Nothing Then
For Each rCell In Rng2.Cells
With rCell
Select Case LCase(.Value)
Case Is = "c", "C"
.Interior.Color = RGB(255, 0, 0)
Case Else
'.Interior.ColorIndex = xlNone '<<< nessun colore
End Select
End With
Next rCell
End If
    
    
Set Rng = Range("O8:O5000") '<<=== da CAMBIARE
Set Rng2 = Intersect(Rng, Target)
If Not Rng2 Is Nothing Then
For Each rCell In Rng2.Cells
With rCell
Select Case LCase(.Value)
Case Is = "a", "A"
.Interior.Color = RGB(0, 255, 0)
Case Else
'.Interior.ColorIndex = xlNone '<<< nessun colore
End Select
End With
Next rCell
End If
       


End Sub

[alexps81Moderatore alexps81 Karma: 58 pts]

Chiaramente lo devi mettere nel modulo del Foglio e non in uno standard

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
    
    Set rng = Me.Range("L8:L3000,M8:M3000,N8:N3000,O8:O3000")
  
    If Not Intersect(Target, rng) Is Nothing Then
                     
        Select Case Target.Column
            Case 12 ' Column L
                Target.Interior.color = RGB(0, 176, 240)
            Case 13 ' Column M
                Target.Interior.color = RGB(255, 204, 0)
            Case 14 ' Column N
                Target.Interior.color = RGB(255, 0, 0)
            Case 15 ' Column O
                Target.Interior.color = RGB(0, 255, 0)
        End Select
               
    End If

Set rng = Nothing

End Sub

Poi non hai più dato riscontro in questo Thread:

stampa da pulsante/macro non da barra degli strumenti

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Ciao alexps81 manca la lettera

Case 12 ' Column L
letter = "P"
Case 13 ' Column M
letter = "D"
Case 14 ' Column N
letter = "C"
Case 15 ' Column O
letter = "A"

 

[alexps81Moderatore alexps81 Karma: 58 pts]

frank_ciccio ha scritto:

manca la lettera

Ma a che serve la variabile "letter"?

[scossaPartecipante scossa Karma: 37 pts]

alexps81 ha scritto:

Set rng = Me.Range("L8:L3000,M8:M3000,N8:N3000,O8:O3000")

Perchè non semplicemente Set rng = Me.Range("L8:O3000") ?

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Per inseire solo una lettera

[alexps81Moderatore alexps81 Karma: 58 pts]

Ahhh si certo certo...ma neanche gli ho dato tanto peso al range...ero concentrato a capire cosa servissero tutte quelle variabili tra cui letter che non ho ancora capito a cosa serve.   

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Case 12 ' Column L
solo lettera letter = "P"
Case 13 ' Column M
solo lettera letter = "D"
Case 14 ' Column N
solo lettera letter = "C"
Case 15 ' Column O
solo lettera letter = "A"

[alexps81Moderatore alexps81 Karma: 58 pts]

Ma quindi ti serve che se nella colonna "L", dalla riga 8 alla riga 3000, fin quando scrivi "P" allora si colora di azzurro, se invece ti trovi nella colonna "M", da riga 8 a riga 3000, se scrivi "D" allora si colora di arancione, e così via per colonna "N" e "O"...giusto?

Be' nel titolo avevi indicato solo "macro colora celle" e nella descrizione del problema non avevi menzionato questa circoscrizione dei casi in cui devono avvenire le colorazioni. Comunque, con il codice che hai ottenuto dai suggerimenti, non dovrebbe essere difficile arrivare alla soluzione. Basta anche un minimo di inglese scolastico per leggere ciò che svolge e adattarlo.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
    
    Set rng = Me.Range("L8:O3000")
  
    If Not Intersect(Target, rng) Is Nothing Then
                     
        Select Case Target.Column
            Case 12 ' Column L
                If Target.Value2 = "P" Then
                    Target.Interior.Color = RGB(0, 176, 240)
                Else
                    Target.Interior.Color = xlNone
                End If
            Case 13 ' Column M
                If Target.Value2 = "D" Then
                    Target.Interior.Color = RGB(255, 204, 0)
                Else
                    Target.Interior.Color = xlNone
                End If
            Case 14 ' Column N
                If Target.Value2 = "C" Then
                    Target.Interior.Color = RGB(255, 0, 0)
                Else
                    Target.Interior.Color = xlNone
                End If
            Case 15 ' Column O
                If Target.Value2 = "A" Then
                    Target.Interior.Color = RGB(0, 255, 0)
                Else
                    Target.Interior.Color = xlNone
                End If
        End Select
               
    End If

Set rng = Nothing

End Sub

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Grazie alexps81

[Autore]

Articoli