Ik heb onderstaande macro gemaakt in visual basic. Echter is het probleem dat bij de optelling van de kleuren blauw en groen altijd een waarde van 1 wordt aangehouden. Hoe maak ik het zo dat in in bepaalde cellen onafhankelijk van kleur standaard een aftrek plaatsvindt van 0.25 ?
' Start loop
For Rij = 2 To 45
Groen = 0
Rood = 0
Blauw = 0
Range("B" & Rij).Select
If ActiveCell.FormulaR1C1 <> "" Then
Range("C" & Rij).Select
Waardering
Range("D" & Rij).Select
Waardering
Range("E" & Rij).Select
Waardering
Range("F" & Rij).Select
Waardering
Range("G" & Rij).Select
Waardering
Range("H" & Rij).Select
Waardering
Range("I" & Rij).Select
Waardering
Range("J" & Rij).Select
Waardering
Range("K" & Rij).Select
Waardering
Range("L" & Rij).Select
Waardering
Range("M" & Rij).Select
Waardering
Range("N" & Rij).Select
Waardering
Range("O" & Rij).Select
Waardering
Range("P" & Rij).Select
Waardering
Range("Q" & Rij).Select
Waardering
Range("R" & Rij).Select
Waardering
Range("S" & Rij).Select
If Groen > 0 Then
ActiveCell.FormulaR1C1 = Groen + Blauw
End If
Range("T" & Rij).Select
If Groen > 0 Then
If Groen <= 5 Then
ActiveCell.FormulaR1C1 = Groen - 0.25
Else
ActiveCell.FormulaR1C1 = Groen - 0.5
End If
Else
ActiveCell.FormulaR1C1 = Groen
End If
End If
Next Rij
Range("A1").Select
End Sub
Public Sub Waardering()
If Selection.Interior.ColorIndex = 4 Then Groen = Groen + 1
If Selection.Interior.ColorIndex = 3 Then Rood = Rood + 1
If Selection.Interior.ColorIndex = 8 Then Blauw = Blauw + 1
End Sub
' Start loop
For Rij = 2 To 45
Groen = 0
Rood = 0
Blauw = 0
Range("B" & Rij).Select
If ActiveCell.FormulaR1C1 <> "" Then
Range("C" & Rij).Select
Waardering
Range("D" & Rij).Select
Waardering
Range("E" & Rij).Select
Waardering
Range("F" & Rij).Select
Waardering
Range("G" & Rij).Select
Waardering
Range("H" & Rij).Select
Waardering
Range("I" & Rij).Select
Waardering
Range("J" & Rij).Select
Waardering
Range("K" & Rij).Select
Waardering
Range("L" & Rij).Select
Waardering
Range("M" & Rij).Select
Waardering
Range("N" & Rij).Select
Waardering
Range("O" & Rij).Select
Waardering
Range("P" & Rij).Select
Waardering
Range("Q" & Rij).Select
Waardering
Range("R" & Rij).Select
Waardering
Range("S" & Rij).Select
If Groen > 0 Then
ActiveCell.FormulaR1C1 = Groen + Blauw
End If
Range("T" & Rij).Select
If Groen > 0 Then
If Groen <= 5 Then
ActiveCell.FormulaR1C1 = Groen - 0.25
Else
ActiveCell.FormulaR1C1 = Groen - 0.5
End If
Else
ActiveCell.FormulaR1C1 = Groen
End If
End If
Next Rij
Range("A1").Select
End Sub
Public Sub Waardering()
If Selection.Interior.ColorIndex = 4 Then Groen = Groen + 1
If Selection.Interior.ColorIndex = 3 Then Rood = Rood + 1
If Selection.Interior.ColorIndex = 8 Then Blauw = Blauw + 1
End Sub