Andiamo per gradi e introduciamo la limitazione di un unico foglio di lavoro.
Se i dati sono su più fogli al momento non ti so dire. Per questo ti dicevo all'inizio che è difficile rispondere perché si inizia in un modo e poi si aggiungo altri particolari.
Mettiamo di voler generalizzare la prima soluzione ed estenderla al caso di n celle soggetto a ricalcolo.
Poniamo che le celle sono al momento due:
- C1 = A1 + B1
- C3 = A3 + A4
Nel primo esempio la cella C1 è utilizzata direttamente nel codice che serve per colorarla. E' evidente che essendo ora due le celle da colorare, dovrei ripetere per due volte lo stesso codice e n volte se le celle fossero n.
Penso, allora, che sia più conveniente ricorrere ad un dizionario perché permette di indicizzare questi valori e quindi di riferirsi via via a ciascuna cella all'interno di un ciclo iterativo. In questo modo posso riutilizzare lo stesso codice per trattare tutte le n diverse celle.
Per memorizzare i valori, invece, è utile un vettore con la stessa dimensione del dizionario.
Ho così riscritto l'esempio precedente ipotizzando due celle da colorare.
Ho aggiunto un evento Activate dove dichiarare e inizializzare il dizionario e il vettore dei valori.
Codice:
Private Sub Worksheet_Activate()
Dim i As Long
Set Diz = CreateObject("Scripting.Dictionary")
i = i + 1: Diz.Add i, "C1"
i = i + 1: Diz.Add i, "C3"
ReDim oldValue(Diz.Count)
End Sub
Di conseguenza, gli eventi Change e SelectionChange sono stati riscritti con all'interno il ciclo sul dizionario.
In definitiva, l'intera procedura è nel dettaglio questa:
Codice:
Option Explicit
Option Base 1
Private oldValue() As Variant
Private Diz As Object
Private Sub Worksheet_Activate()
Set Diz = CreateObject("Scripting.Dictionary")
Diz.Add 1, "C1"
Diz.Add 2, "C3"
ReDim oldValue(Diz.Count)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If Not IsNumeric(Target.Value) Then
Exit Sub
End If
For i = 1 To Diz.Count
If Not IsNull(oldValue(i)) Then
If Range(Diz(i)).Value > oldValue(i) Then
Range(Diz(i)).Interior.Color = vbGreen
ElseIf Range(Diz(i)).Value < oldValue(i) Then
Range(Diz(i)).Interior.Color = vbRed
End If
End If
Next i
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
For i = 1 To Diz.Count
oldValue(i) = Null
If IsNumeric(Range(Diz(i)).Value) Then
oldValue(i) = Range(Diz(i)).Value
End If
Next
End Sub
Per aggiungere ulteriori celle da colorare basta semplicemente aggiungerle nell'evento Activate, allungando la lista degli .Add.
A esempio, volendo aggiungere le celle J1 e J2, l'evento Activate diventerebbe:
Codice:
Private Sub Worksheet_Activate()
Dim i As Long
Set Diz = CreateObject("Scripting.Dictionary")
i = i + 1: Diz.Add i, "C1"
i = i + 1: Diz.Add i, "C3"
i = i + 1: Diz.Add i, "J1"
i = i + 1: Diz.Add i, "J2"
ReDim oldValue(Diz.Count)
End Sub
e così via.
P.S.: Ho tolto il colore Blue perché questa eventualità crea problemi a più livelli.
