Sub Wahrheitstabelle()
Dim AnzahlSpalten As Integer
Dim i As Long, j As Long, k As Long
Dim letzteZeile As Long
Dim ws As Worksheet
' Aktuelles ArbeitsblattSet ws = ActiveSheet
' Anzahl der Werte - stehen im Bsp. in P1
AnzahlSpalten = ws.Range("P1").Value
' Alle Zellen im aktiven Arbeitsblatt löschen
ws.Cells.ClearContents
ws.Cells.FormatConditions.Delete
ws.Cells.Interior.ColorIndex = xlNone
ws.Cells.Borders.LineStyle = xlNone
' Anzahl der Zeilen berechnen (2 hoch AnzahlSpalten; Bei 3 Werte wären es 2 hoch 3 = 2*2*2 = 8 Zeilen)
letzteZeile = 2 ^ AnzahlSpalten
' Überschriften in der ersten zeile für die Spalten erstellenFor i = 1To AnzahlSpalten
ws.Cells(1, i) = "Wert_" & i
Next i
With ws.Range(ws.Cells(1, 1), ws.Cells(1, AnzahlSpalten))
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Borders(xlBottom).LineStyle = xlContinuous
EndWith' Wahrheitstabelle füllen'Angenommen, wir sind in der zweiten Zeile (also i = 2) und der dritten Spalte (j = 3).'Dann ist k = 1 und 2 ^ (j - 1) = 4. In binärer Darstellung ist 1 = 001 und 4 = 100.'Da an keiner Stelle beide Zahlen eine 1 haben, ist das Ergebnis 0 = False.'am Ende prüfen wir noch ob das Ergebnis ungleich 0 ist.For i = 2To letzteZeile + 1
k = i - 1For j = 1To AnzahlSpalten
ws.Cells(i, j) = (k And2 ^ (j - 1)) <> 0' Bedingte Formatierung basierend auf dem WertIf ws.Cells(i, j).Value Then
ws.Cells(i, j).Interior.Color = RGB(200, 255, 200) ' HellgrünElse
ws.Cells(i, j).Interior.Color = RGB(255, 200, 200) ' HellrotEndIf' Rahmen für die erste und letzte Spalte jeder ZeileIf j = 1Then
ws.Cells(i, j).Borders(xlEdgeLeft).LineStyle = xlContinuous
ElseIf j = AnzahlSpalten Then
ws.Cells(i, j).Borders(xlEdgeRight).LineStyle = xlContinuous
EndIfNext j
ws.Range(ws.Cells(i, 1), ws.Cells(i, AnzahlSpalten)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Next i
With ws.Range("P1")
.Value = AnzahlSpalten
.Interior.Color = RGB(245, 158, 30)
EndWithEndSubSub Und()
Dim AnzahlSpalten As Long
Dim Zeile As Long
Dim i As Long
Dim ws As Worksheet
Set ws = ActiveSheet
AnzahlSpalten = ws.Range("P1").Value
letzteZeile = 2 ^ AnzahlSpalten
' Überschriften für die Spalten erstellen
ws.Cells(1, AnzahlSpalten + 2) = "Und"With ws.Cells(1, AnzahlSpalten + 2)
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Borders(xlBottom).LineStyle = xlContinuous
EndWith'für jede Zeile die Spalten 1 - Anzahl Spalten mit And verknüpfen zB. =Und(A1:A3)For i = 2To letzteZeile + 1
ws.Cells(i, AnzahlSpalten + 2).Formula = "=AND(" & ws.Cells(i, 1).Address & ":" & ws.Cells(i, AnzahlSpalten).Address & ")"If ws.Cells(i, AnzahlSpalten + 2).Value Then
ws.Cells(i, AnzahlSpalten + 2).Interior.Color = RGB(200, 255, 200) ' HellgrünElse
ws.Cells(i, AnzahlSpalten + 2).Interior.Color = RGB(255, 200, 200) ' HellrotEndIfNext i
EndSubSub Oder()
Dim AnzahlSpalten As Long
Dim Zeile As Long
Dim i As Long
Dim ws As Worksheet
Set ws = ActiveSheet
AnzahlSpalten = ws.Range("P1").Value
letzteZeile = 2 ^ AnzahlSpalten
' Überschriften für die Spalten erstellen
ws.Cells(1, AnzahlSpalten + 3) = "Oder"With ws.Cells(1, AnzahlSpalten + 3)
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Borders(xlBottom).LineStyle = xlContinuous
EndWith'für jede Zeile die Spalten 1 - Anzahl Spalten mit OR verknüpfen zB. =Oder(A1:A3)For i = 2To letzteZeile + 1
ws.Cells(i, AnzahlSpalten + 3).Formula = "=OR(" & ws.Cells(i, 1).Address & ":" & ws.Cells(i, AnzahlSpalten).Address & ")"If ws.Cells(i, AnzahlSpalten + 3).Value Then
ws.Cells(i, AnzahlSpalten + 3).Interior.Color = RGB(200, 255, 200) ' HellgrünElse
ws.Cells(i, AnzahlSpalten + 3).Interior.Color = RGB(255, 200, 200) ' HellrotEndIfNext i
EndSubSub ExOder()
Dim AnzahlSpalten As Long
Dim Zeile As Long
Dim i As Long
Dim ws As Worksheet
Set ws = ActiveSheet
AnzahlSpalten = ws.Range("P1").Value
letzteZeile = 2 ^ AnzahlSpalten
' Überschriften für die Spalten erstellen
ws.Cells(1, AnzahlSpalten + 4) = "XOR"With ws.Cells(1, AnzahlSpalten + 4)
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Borders(xlBottom).LineStyle = xlContinuous
EndWith'für jede Zeile die Spalten 1 - Anzahl Spalten mit XOR verknüpfen zB. =XOder(A1:A3)For i = 2To letzteZeile + 1
ws.Cells(i, AnzahlSpalten + 4).Formula = "=XOR(" & ws.Cells(i, 1).Address & ":" & ws.Cells(i, AnzahlSpalten).Address & ")"If ws.Cells(i, AnzahlSpalten + 4).Value Then
ws.Cells(i, AnzahlSpalten + 4).Interior.Color = RGB(200, 255, 200) ' HellgrünElse
ws.Cells(i, AnzahlSpalten + 4).Interior.Color = RGB(255, 200, 200) ' HellrotEndIfNext i
EndSubSub Aequivalenz()
Dim AnzahlSpalten As Long
Dim Zeile As Long
Dim i As Long
Dim ws As Worksheet
Set ws = ActiveSheet
AnzahlSpalten = ws.Range("P1").Value
letzteZeile = 2 ^ AnzahlSpalten
' Überschriften für die Spalten erstellen
ws.Cells(1, AnzahlSpalten + 5) = "Äquivalenz"With ws.Cells(1, AnzahlSpalten + 5)
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Borders(xlBottom).LineStyle = xlContinuous
EndWithFor i = 2To letzteZeile + 1Dim alleGleich As Boolean
alleGleich = True' Vergleiche alle Zellen in der ZeileFor Spalte = 2To AnzahlSpalten
If ws.Cells(i, Spalte).Value <> ws.Cells(i, Spalte - 1).Value Then
alleGleich = FalseExitFor' Abbrechen, wenn ein Unterschied gefunden wurdeEndIfNext Spalte
' Ergebnis in die Zielzelle schreiben
ws.Cells(i, AnzahlSpalten + 5).Value = alleGleich
'ws.Cells(i, AnzahlSpalten + 5).Formula = "=IF(" & ws.Cells(i, 1).Address & "=" & ws.Cells(i, 2).Address & ",TRUE,FALSE)"If ws.Cells(i, AnzahlSpalten + 5).Value Then
ws.Cells(i, AnzahlSpalten + 5).Interior.Color = RGB(200, 255, 200) ' HellgrünElse
ws.Cells(i, AnzahlSpalten + 5).Interior.Color = RGB(255, 200, 200) ' HellrotEndIfNext i
EndSubCode-Sprache:VBScript(vbscript)