Hallo, ich versuche zurzeit eine Ecxel Tabelle zu erstellen, in der ich automatisiert ein Häkelmuster berechnen kann.
Eigentlich denke ich ist es ganz einfach, finde aber den fehler nicht, weshalb das Script nicht das macht was es machen soll. Die Grundregeln sind im Prinzip, das ich eine Tabelle habe wo eine Zeile immer mit grüner Farbe gehäkelt wird und die nächste in Weißer Farbe. Es wir unten in der Tabelle angefangen und dann von unten noch oben gearbeitet.
Das knifflige dabei ist, das um ein Muster zu erstellen, in einer Grünen Zeile auch eine Weiße Zelle sein kann (oder in einer Weißen Zeile eine Grüne Zelle). Wenn dies der Fall ist, soll in die Zelle darüber ein "X" gesetzt werden.
So sollen die Kreuze gesetzt werden, es ist einfacher wenn Ihr auf das untere der beiden schaut. Links und rechts sind jeweils abwechselnd mit blau und Weiß die Reihenfarben angegeben. Wenn in einer Blauen reihe ein weißes Feld ist wird über dieses Weißes Feld ein "X" gesetzt. Andersherum auch in den Weißen Reihen, dort wird wenn es ein Blaues Kästchen gibt über das Blaue Kästchen ein "X" gesetzt.
Im großen und ganzen wars das schon. Wenn in einer Reihe eine andere Farbe ist als eigentlich vorgesehen soll in die reihe darüber ein "X" gesetzt werden.
Aktuell werden die Kreuze gefühlt willkührlich gesetzt:
Sub SetXForStabchen()
Dim ws As Worksheet
Dim cell As Range
Dim currentRowColor As Long
Dim currentCellColor As Long
Dim belowRowColor As Long
Dim whiteColor As Long
Dim greenColor As Long
Dim lastRow As Long
Dim rowIndex As Long
Dim colIndex As Long
' Setze das Arbeitsblatt, das verwendet wird
Set ws = ThisWorkbook.Sheets("Tabelle1") ' Passe den Namen des Arbeitsblatts an
' Definiere die Farben
whiteColor = RGB(255, 255, 255) ' Weiß
greenColor = RGB(0, 255, 0) ' Grün
' Finde die letzte Zeile im Arbeitsblatt mit Daten
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' Durchlaufe jede Zelle im ausgewählten Bereich
For Each cell In Selection
rowIndex = cell.Row
colIndex = cell.Column
' Bestimme die Farbe der aktuellen Zelle
currentCellColor = cell.Interior.Color
' Bestimme die Farbe der Reihe, in der sich die Zelle befindet
If rowIndex Mod 2 = 1 Then
currentRowColor = greenColor ' Ungerade Reihen sind Grün
Else
currentRowColor = whiteColor ' Gerade Reihen sind Weiß
End If
' Überprüfe die Farbe der darunter liegenden Zelle
If rowIndex < lastRow Then
belowRowColor = ws.Cells(rowIndex + 1, colIndex).Interior.Color
Else
belowRowColor = RGB(255, 255, 255) ' Weiß, falls keine darunter liegende Zelle existiert
End If
' Setze ein "X" in die Zelle darüber, wenn die Farben unterschiedlich sind
If currentRowColor = whiteColor And currentCellColor = greenColor And belowRowColor = whiteColor Then
cell.Offset(-1, 0).Value = "X" ' Weiß wird über Grün gesetzt: X in die Zelle darüber
ElseIf currentRowColor = greenColor And currentCellColor = whiteColor And belowRowColor = greenColor Then
cell.Offset(-1, 0).Value = "X" ' Grün wird über Weiß gesetzt: X in die Zelle darüber
End If
Next cell
End Sub
Ich würde mch sehr freuen wenn mir dabei jemand helfen kann. Ich bin nicht wirklich geübt in VBA.
|