modifica macro per mese-cella

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Ciao,

questa macro funziona per la colonna B

'-----------------------------------------------------------

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B4:B1200")) Is Nothing Then
On Error Resume Next
Select Case Month(Target)
Case 1
Target.Interior.ColorIndex = 6
Case 2
Target.Interior.ColorIndex = 8
Case 3
Target.Interior.ColorIndex = 6
Case 4
Target.Interior.ColorIndex = 8
Case 5
Target.Interior.ColorIndex = 6
Case 6
Target.Interior.ColorIndex = 8
Case 7
Target.Interior.ColorIndex = 6
Case 8
Target.Interior.ColorIndex = 8
Case 9
Target.Interior.ColorIndex = 6
Case 10
Target.Interior.ColorIndex = 8
Case 11
Target.Interior.ColorIndex = 6
Case 12
Target.Interior.ColorIndex = 8
End Select
On Error GoTo 0
End If
End Sub

'-----------------------------------------------------------

è possibile modificarla perchè funzioni per le righe da A a D?

grazie

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Per favore utilizza l'apposita funzione per presentare del codice. Nell'editor c'e' il pulsante "(codice VBA)".

frank_ciccio ha scritto:

è possibile modificarla perchè funzioni per le righe da A a D?

La risposta alla domanda e' si', certo. Non e' molto difficile immaginarsi dove e come apportare la modifica. Fai un piccolo sforzo.

[alexps81Moderatore alexps81 Karma: 58 pts]

Dopo che hai trovato la soluzione...ti suggerisco di aggregare i vari casi visto che si parla solo del ColorIndex 6 e 8

Select Case Month(Target)
Case 1, 3, 5, 7, 9, 11
    Target.Interior.ColorIndex = 6
Case Else
    Target.Interior.ColorIndex = 8
End Select

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

alexps81 ha scritto:

ti suggerisco di aggregare i vari casi

Ciliegina sulla torta, ma prima bisogna avere la torta   

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Non so se c'è di meglio

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B4:B1200")) Is Nothing Then
On Error Resume Next
Select Case Month(Target)

Case 1
'Target.Interior.ColorIndex = 6
Target.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 6
Case 2
'Target.Interior.ColorIndex = 8
Target.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 8

Case 3
'Target.Interior.ColorIndex = 6
Target.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 6
Case 4
'Target.Interior.ColorIndex = 8
Target.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 8

Case 5
'Target.Interior.ColorIndex = 6
Target.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 6
Case 6
'Target.Interior.ColorIndex = 8
Target.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 8

Case 7
'Target.Interior.ColorIndex = 6
Target.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 6
Case 8
'Target.Interior.ColorIndex = 8
Target.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 8

Case 9
'Target.Interior.ColorIndex = 6
Target.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 6
'Target.Interior.ColorIndex = 8
Target.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 8

Case 11
'Target.Interior.ColorIndex = 6
Target.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 6
Case 12
'Target.Interior.ColorIndex = 8
Target.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 8

End Select
On Error GoTo 0
End If
End Sub

[Autore]

Articoli