VBA Makro Werte vergleichen
Andreas
hab da mal ein Anliegen. In einer Arbeitsmappe mit div. Blättern, habe ich immer in den Spalten 7-9 Werte, welche miteinander verglichen werden sollen. Spalte 7 ist der Ursprungswert und Spalte 8 + 9 sind nachträgliche Eingaben, welche mit dem Wert aus Spalte 7 verglichen werden. Ergeben nun die Eingaben zu 7 eine Abweichung von +- 0,1, so soll die Schrift schwarz bleiben. Ist der Wert zwischen +- 0,1 - 0,2, so soll die Schrift gelb dargestellt werden und bei Werten größer +- 0,2 rot. Bei einer Änderung in Spalte 7 sollen auch die evtl. schon vorhanden Werte in 8 + 9 neu verglichen werden.
Habe dazu zunächst die bedingte Formatierung herangezogen, welche aber Probleme machte, da die Blätter einen gewissen Schutz und Freigaben enthalten. Habe es dann mittels VBA hinterlegt, was auch recht gut funktioniert, aber nun zu einem seltsamen Fehler führt. Ist der Zellwert in 7 zB 4,2 / 5,2 / ..., so wird ein Wert in 8 + 9 von 4,1 ... als gelb dargestellt und nicht schwarz. Wenn ich den Wert auf 4,21 (7) und 4,11 (8 + 9) veränder, so ist alles i.O.. Ist das nun mein Fehler, oder ein Fehler von VBA und Excel?
Hier das Makro, welches in DieseArbeitsmappe hinterlegt ist:
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal target As Range)
If target.Column = (7) Or target.Column = (8) Or target.Column = (9) Then
If Not IsNumeric(target) Then GoTo ende:
On Error Resume Next
'tar = target
If target.Column = 7 Then
If target.Offset(0, 1) = target - 0.1 _
Then
target.Offset(0, 1).Font.ColorIndex = 1 ' schwarz
GoTo mibiend:
End If
If target.Offset(0, 1) target + 0.2 _
Then
target.Offset(0, 1).Font.ColorIndex = 3 ' rot
GoTo mibiend:
End If
If target.Offset(0, 1) target + 0.1 _
Then
target.Offset(0, 1).Font.ColorIndex = 6 ' gelb
GoTo mibiend:
End If
mibiend:
If target.Offset(0, 2) = target - 0.1 _
Then
target.Offset(0, 2).Font.ColorIndex = 1 ' schwarz
GoTo ende:
End If
If target.Offset(0, 2) target + 0.2 _
Then
target.Offset(0, 2).Font.ColorIndex = 3 ' rot
GoTo ende:
End If
If target.Offset(0, 2) target + 0.1 _
Then
target.Offset(0, 2).Font.ColorIndex = 6 ' gelb
GoTo ende:
End If
End If
If target.Column = 8 Then
'MsgBox (Target.Offset(0, -1) - 0.1)
'MsgBox (Target.Offset(0, -1) + 0.1)
If target = (target.Offset(0, -1) - _
0.1) Then
'MsgBox "Wahr"
target.Font.ColorIndex = 1 ' schwarz
GoTo ende:
End If
If target (target.Offset(0, -1) + 0. _
2) Then
target.Font.ColorIndex = 3 ' rot
GoTo ende:
End If
If target (target.Offset(0, -1) + 0. _
1) Then
target.Font.ColorIndex = 6 ' gelb
GoTo ende:
End If
End If
If target.Column = 9 Then
If target = (target.Offset(0, -2) - _
0.1) Then
target.Font.ColorIndex = 1 ' schwarz
GoTo ende:
End If
If target (target.Offset(0, -2) + 0. _
2) Then
target.Font.ColorIndex = 3 ' rot
GoTo ende:
End If
If target (target.Offset(0, -2) + 0. _
1) Then
target.Font.ColorIndex = 6 ' gelb
GoTo ende:
End If
End If
End If
ende:
End Sub
Hoffe ja, dass man mich schlau machen kann. Das Makro kann bestimmt noch besser schreiben, bin aber Anfänger und habe nie einen Kurs besucht.
Mit freundlichen Grüßen
Andreas
