Excel Makro 2 ZELLEN addieren und Vergleichen

Question

Hallo Leute

einfache Aufgabe für Excel Profis

Würde gerne per Makro 2 Zellen B1+B2 zusammenzählen und mit A1 vergleichen

wenn gleiches Ergebniss oder +1/-1 vom Ergebniss abweichend dann Msb alles o.k

zb.

B1(10)+B2(9)

A1(19) od A1(18) od A1(20)

dann Msb alles o.k

Answer 1

Hallo,

hier ein Beispiel, wie man so etwas lösen kann:

Sub vergleich()
Dim i As Integer
Dim bTrue As Boolean

'Bereich +/-1 von Wert aus A1 prüfen
For i = Range("A1").Value - 1 To Range("A1").Value + 1
  If i = Range("B1").Value + Range("B2").Value Then
    bTrue = True
    Exit For
  End If
Next i

'Ausgabe Messagebox
If bTrue = True Then
  MsgBox "Alles Ok!", 48, "Prüfung erfolgreich"
 Else
  MsgBox "Nicht OK!", 16, "Prüfung fehlgeschlagen"
End If

End Sub

Oder nur mit Messagebox bei erfolgreichem Vergleich:

Sub vergleich2()
Dim i As Integer

'Bereich +/-1 von Wert aus A1 prüfen
For i = Range("A1").Value - 1 To Range("A1").Value + 1
  If i = Range("B1").Value + Range("B2").Value Then
    MsgBox "Alles Ok!", 48, "Prüfung erfolgreich"
    Exit For
  End If
Next i

End Sub

Gruß

M.O.

Answer 2

Hi M.O

Super Danke

und wenn ich 2 Werte zusammengezählt vergleichen möchte

wie würde das dann aussehen?

A1+A2 zusammengezählt vergleich mit B1+B2 zusammengezählt mit +/- 1

Kannst du mir das Bitte auch noch zeigen !!!!

Answer 3

Hallo,

ganz einfach so:

Sub vergleich3()
Dim i As Integer
Dim bTrue As Boolean

'Bereich +/-1 von Wert aus Summe A1 und A2 prüfen
For i = Range("A1").Value + Range("A2").Value - 1 To Range("A1").Value + Range("A2").Value + 1
  If i = Range("B1").Value + Range("B2").Value Then
    bTrue = True
    Exit For
  End If
Next i

'Ausgabe Messagebox
If bTrue = True Then
  MsgBox "Alles Ok!", 48, "Prüfung erfolgreich"
 Else
  MsgBox "Nicht OK!", 16, "Prüfung fehlgeschlagen"
End If

End Sub

Gruß

M.O.

Answer 4

Super M.O

Vielen Dank

Answer 5

Hi M.O

Könntest du mir bitte noch eine kleine Anpassung durchführen.

Wenn man die Werte A1+A2 od. B1+B2 zusammenzählt darf der Wert nicht höher als 50 sein

Die vergleichbaren Werte sollen max bis 50 gehen

Answer 6

Hallo,

dann so:

Sub vergleich4()
Dim i As Integer
Dim bTrue As Boolean
Dim a As Double
Dim b As Double

'Werte addieren
a = Range("A1").Value + Range("A2").Value
b = Range("B1").Value + Range("B2").Value

'Prüfen, ob Summen kleiner gleich 50 sind
If a > 50 Or b > 50 Then
  MsgBox "Die Summen dürfen nicht größer als 50 sein. Abbruch!", 16, "Fehler"
  'Makro verlassen
  Exit Sub
End If

'Bereich +/-1 von Wert aus Summe A1 und A2 prüfen
For i = a - 1 To a + 1
  If i = b Then
    bTrue = True
    Exit For
  End If
Next i

'Ausgabe Messagebox
If bTrue = True Then
  MsgBox "Alles Ok!", 48, "Prüfung erfolgreich"
 Else
  MsgBox "Nicht OK!", 16, "Prüfung fehlgeschlagen"
End If

End Sub

Gruß

M.O.

Answer 7

Klasse M.O

Eine Frage noch

Ich hab dein Makro jetzt angepasst wo ich auch C mit D vergleichen kann und die Zellen eingefärbt werden.

Super wäre wenn das Makro nur ausgeführt wenn beide Bedingunegn wahr sind

allso A+B = o.k

C+D = o.k

ansonsten alles Super

Danke

Answer 8

Hallo,

welche Bedingungen sollen denn erfüllt sein, dass das Makro ausgeführt wird (<50 oder der Vergleich)?

Gruß

M.O.

Answer 9

Beides

A1+A2 zusammengezählt sollen <50 sein und +/-1 von B1+B2 zusammengezählt <50 entfernt sein

+

C1+C2 zusammengezählt sollen <50 sein und +/-1 von D1+D2 zusammengezählt <50 entfernt sein

Makro nur dann ausführen wenn AB +CD übereinstimmen

Answer 10

Hallo,

versuche es mal so:

Sub vergleich5()
Dim i As Integer
Dim bABTrue As Boolean
Dim bCDTrue As Boolean
Dim a As Double
Dim b As Double
Dim c As Double
Dim d As Double

'Werte addieren
a = Range("A1").Value + Range("A2").Value
b = Range("B1").Value + Range("B2").Value
c = Range("C1").Value + Range("C2").Value
d = Range("D1").Value + Range("D2").Value

'Prüfen, ob Summen kleiner gleich 50 sind
If a > 50 Or b > 50 Or c > 50 Or d > 50 Then
  MsgBox "Die Summen dürfen nicht größer als 50 sein. Abbruch!", 16, "Fehler"
  'Makro verlassen
  Exit Sub
End If

'Bereich +/-1 von Wert aus Summen A und B
For i = a - 1 To a + 1
  If i = b Then
    bABTrue = True
    Exit For
  End If
Next i

'Bereich +/-1 von Wert aus Summen C und D prüfen
For i = c - 1 To c + 1
  If i = d Then
    bCDTrue = True
    Exit For
  End If
Next i

'Ausgabe Messagebox
If bABTrue = True And bCDTrue = True Then
  MsgBox "Alles Ok!", 48, "Prüfung erfolgreich"
 Else
  MsgBox "Nicht OK!", 16, "Prüfung fehlgeschlagen"
End If

End Sub

Gruß

M.O.