Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Makro Werte vergleichen

Forumthread: VBA Makro Werte vergleichen

VBA Makro Werte vergleichen
Andreas
Hallo VBA-Freaks,
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
Anzeige
AW: VBA Makro Werte vergleichen
23.06.2010 11:51:48
Andreas
Hallo,
grad gesehen, dass man auch Dateien hochladen kann. Hier eine Testdatei, welche mein Problem zeigt.
https://www.herber.de/bbs/user/70234.xls
Grüße
Andreas
Lösung ohne VBA : Bedingte Formatierung
23.06.2010 12:15:22
NoNet
Hallo Andreas,
MUSST Du das unbedingt per VBA lösen ?
Das lässt sich auch prima ohne VBA-Code per "Format - Bedingte Formatierung" lösen :
Userbild
Die Differenzen 0,201 und 0,101 anstatt 0,2 und 0,1 sollen die Ungenauigkeiten bei Excel Rundungsfehlern ausgleichen !
Gruß, NoNet
Anzeige
AW: Lösung ohne VBA : Bedingte Formatierung
23.06.2010 12:26:55
Andreas
Hallo NoNet,
leider hatte ich bei der Gesamtdatei und den restlichen Funktionen/Eigenschaften Probleme mit der bedingten Formatierung, weshalb ich es über VBA gelöst habe. Die bedingte bläht mir auch die Datei etwas unnötig auf.
Was ich halt nicht verstehe ist, dass es, bei glatten Zahlen ohne was runden zu müssen, zu diesem Fehler kommt, aber der Tipp mit dem 0,101 ist gut. Habe es im Makro so hinterlegt und es funktioniert.
Verstehen tue ich den Fehler dennoch nicht.
Danke und Grüße
Andreas
Anzeige
VBA-Alternative : ROUND und kürzerer Code
23.06.2010 12:54:15
NoNet
Hallo Andreas,
hier noch eine wesentlich Kürzere VBA-Alternative, die zudem auch noch Mehrfacheingaben per STRG+ENTER berücksichtigt. Das Rundungsproblem habe ich hier per Application.ROUND(...,3) gelöst (also : Runden auf 3 Nachkommastellen !) :
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal target As Range)
Dim rngZelle As Range, lngS As Long
If Not Intersect([G:I], target) Is Nothing Then
For Each rngZelle In Intersect([G:G], target.EntireRow.Rows)
For lngS = 8 To 9 'Spalte 8 und 9 überprüfen und ggf. ändern
If Application.Round(Abs(Cells(rngZelle.Row, 7) - _
Cells(rngZelle.Row, lngS)), 3) > 0.2 Then
Cells(rngZelle.Row, lngS).Font.ColorIndex = 3 'rot
ElseIf Application.Round(Abs(Cells(rngZelle.Row, 7) - _
Cells(rngZelle.Row, lngS)), 3) > 0.1 Then
Cells(rngZelle.Row, lngS).Font.ColorIndex = 6 'gelb
Else
Cells(rngZelle.Row, lngS).Font.Color = 0 'Standard : schwarz
End If
Next
Next
End If
End Sub
Gruß, NoNet
Anzeige
AW: VBA-Alternative : ROUND und kürzerer Code
23.06.2010 13:11:29
Andreas
Hallo NoNet,
cool, dazu reichen halt meine Fähigkeiten noch lange nicht aus :-)
Welchen Grund gibt es denn, warum Excel bei gewissen Zahlen, wenn man von 4,2 zB 0,1 abzieht, zu einem Rundungsfehler kommen kann? Wäre ich im Leben nicht drauf gekommen.
Herzlichen Dank für den kompakten Code
Andreas
Anzeige
AW: Rundungsfehler durch IEEE754
24.06.2010 08:10:39
Andreas
Hallo NoNet,
ist ja wirklich witzig mit der "Genauigkeit" von Excel. Hab mir den Artikel von MS durchgelesen und mal getestet. Wenn man die dort angegebene Formel einsetzt, also 1*(0,5-0,4-0,1), dann ist das Ergebnis -2,78E-17. Wenn man aber 1*(0,5-0,1-0,4) nimmt, dann ist es 0 :-)
Mag zwar im Alltag unbedeutend sein, wenn ich mir aber andere Bereiche ansehe und man nicht daran denken würde ....
Hätte ich nicht gedacht. Dann man herzlichen Dank für die Hilfe und das sehr kompakte Makro.
Grüße
Andreas
Anzeige
;
Anzeige
Anzeige

Infobox / Tutorial

VBA Makro zum Vergleichen von Werten optimieren


Schritt-für-Schritt-Anleitung

  1. Öffne Deine Excel-Datei und drücke ALT + F11, um den VBA-Editor zu öffnen.
  2. Füge das folgende Makro in das Modul "DieseArbeitsmappe" ein:
    Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal target As Range)
       Dim rngZelle As Range, lngS As Long
       If Not Intersect([G:I], target) Is Nothing Then
           For Each rngZelle In Intersect([G:G], target.EntireRow.Rows)
               For lngS = 8 To 9 'Spalte 8 und 9 überprüfen und ggf. ändern
                   If Application.Round(Abs(Cells(rngZelle.Row, 7) - Cells(rngZelle.Row, lngS)), 3) > 0.2 Then
                       Cells(rngZelle.Row, lngS).Font.ColorIndex = 3 'rot
                   ElseIf Application.Round(Abs(Cells(rngZelle.Row, 7) - Cells(rngZelle.Row, lngS)), 3) > 0.1 Then
                       Cells(rngZelle.Row, lngS).Font.ColorIndex = 6 'gelb
                   Else
                       Cells(rngZelle.Row, lngS).Font.Color = 0 'Standard : schwarz
                   End If
               Next
           Next
       End If
    End Sub
  3. Schließe den VBA-Editor und kehre zur Excel-Oberfläche zurück.
  4. Testen: Ändere Werte in Spalte 7 und schaue, ob die Schriftfarben in den Spalten 8 und 9 entsprechend der Abweichungen korrekt angezeigt werden.

Häufige Fehler und Lösungen

  • Fehler: Schriftfarbe wird nicht korrekt angezeigt
    Lösung: Stelle sicher, dass Du die Werte in den Zellen korrekt eingibst und dass das Makro aktiv ist. Überprüfe auch, ob es in den Zellen keine nicht-numerischen Werte gibt.

  • Fehler: VBA-Makro führt zu Fehlern bei Rundungen
    Lösung: Nutze die Application.Round-Funktion, um Rundungsfehler zu vermeiden. Achte darauf, die Anzahl der Nachkommastellen auf 3 zu setzen.


Alternative Methoden

Wenn Du das Problem ohne VBA lösen möchtest, kannst Du die bedingte Formatierung in Excel verwenden:

  1. Markiere die Zellen in den Spalten 8 und 9.
  2. Gehe zu Start > Bedingte Formatierung > Neue Regel.
  3. Wähle Formel zur Ermittlung der zu formatierenden Zellen verwenden und gib die entsprechende Formel ein:
    • Für Gelb: =ABS($G1-H1)>0.1
    • Für Rot: =ABS($G1-H1)>0.2
  4. Wähle die gewünschte Formatierung aus und wende sie an.

Praktische Beispiele

  • Beispiel 1: Wenn in Zelle G1 der Wert 4,2 steht und in H1 der Wert 4,1, wird die Schrift in H1 schwarz.
  • Beispiel 2: Bei einem Wert von 4,3 in H1 wird die Schrift gelb, da die Abweichung > 0,1 und <= 0,2 ist.
  • Beispiel 3: Bei einem Wert von 4,5 in H1 wird die Schrift rot, da die Abweichung > 0,2 ist.

Tipps für Profis

  • Verwende Option Explicit am Anfang Deines VBA-Codes, um sicherzustellen, dass alle Variablen deklariert sind. Das hilft, potenzielle Fehler zu vermeiden.
  • Dokumentiere Deinen Code mit Kommentaren, um die Lesbarkeit und Wartbarkeit zu verbessern.
  • Teste Dein Makro gründlich mit verschiedenen Datensätzen, um sicherzustellen, dass es in allen Situationen funktioniert.

FAQ: Häufige Fragen

1. Warum treten Rundungsfehler bei Excel auf?
Die Rundungsfehler entstehen aufgrund der Rechen"genauigkeit" von Excel und des Rechenalgorithmus für Dezimalzahlen gemäß IEEE754.

2. Kann ich die bedingte Formatierung nutzen, auch wenn ich VBA verwende?
Ja, Du kannst die bedingte Formatierung in Kombination mit VBA nutzen, um visuelle Hinweise zu geben, während das Makro die Werte verarbeitet.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige