Thema Datum  Von Nutzer Rating
Antwort
Rot Tabelle automatisieren
13.08.2024 11:58:18 Wiebke
NotSolved
13.08.2024 13:03:05 Gast7777
NotSolved
13.08.2024 19:27:08 ralf_b
NotSolved
16.08.2024 01:32:40 Gast89816
NotSolved

Ansicht des Beitrags:
Von:
Wiebke
Datum:
13.08.2024 11:58:18
Views:
404
Rating: Antwort:
  Ja
Thema:
Tabelle automatisieren

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. smiley

 

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Tabelle automatisieren
13.08.2024 11:58:18 Wiebke
NotSolved
13.08.2024 13:03:05 Gast7777
NotSolved
13.08.2024 19:27:08 ralf_b
NotSolved
16.08.2024 01:32:40 Gast89816
NotSolved