Office: VBA Zellen definiert färben

Hallo,

ich habe folgendes Problem. In meiner Matrix sollen die Zellen ihre Farbe nach Abhänigkeit der Buchstaben verändern. Mit der bedingten Formatierung lässt sich nicht arbeiten, da ich mehr als 3 Bedingungen habe.
Ich habe es schon mit einer If-Then-Else Anweisung ausprobiert.
Die ersten drei Buchstaben färbten sich so wie gewünscht. Leider war ab Buchstabe "D" Schluß.
Mit einer SelectCase Anweisung aus dem Forum konnte ich auch nur 3 Buchstaben einfärben.
Für die Buchstaben "D" und "S" sollen aber auch noch Farben definiert werden.
Kennt jemand die Lösung meines Problems?


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range, Bereich As Range
Set Bereich = Intersect(Target, Range("D16:AH16"))
If Not Bereich Is Nothing Then
For Each Zelle In Bereich
Select Case Zelle.Offset(0, 1 - Zelle.EntireColumn.Column).Text
Case Is = "A"
Zelle.Interior.Color = 4
Case Is = "B"
Zelle.Interior.Color = 6
Case Is = "C"
Zelle.Interior.Color = 8
Case Is = "D"
Zelle.Interior.Color = 29

Case Is = "S"
Zelle.Interior.Color = 46

Case Else
Zelle.Interior.ColorIndex = xlColorIndexNone
End Select
Next Zelle
End If
End Sub

 

ja schreibe weiter
Case is ="E"
...
Case is ="F"
....

Gruß Hajo

 

Hallo,

da kann ich Dir nur gratulieren, dass Du solche Adleraugen hast!

Denn Zelle.Interior.Color=0 ist ja bekanntlich "Schwarz" und selbst bei Zelle.Interior.Color=29 für Buchstabe "D" kann ich nichts anderes als "schwarz" erkennen. Geht der Farbwert Richtung 128=RGB(128,0,0), beginnt sich ein "braun" (Mischung zwischen schwarz und rot) abzuzeichnen, und schließlich bei 255=RGB(255,0,0) ergibt sich ein volles Rot. Grün ergibt sich schließlich bei 255*256=65288=RGB(0,255,0) und blau bei 255*256*256=16711688=RGB(0,0,255),
während (255*256+255)*256+255=16777215=RGB(255,255,255) gleich "weiß" ist.

Dein Makro verhält sich derart, dass bei Änderung eines Wertes im Bereich D16:AH16 die betreffende Zelle in Abhängigkeit vom Wert (Buchstaben) in Zelle A16 eingefärbt wird.

 

Danke für die Antworten.
Ich habe mein Makro jetzt so umgeschrieben das die Zellen sich wie gewünscht verändern.
Einziges Problem besteht noch darin das dies auf dem gesamten Blatt passiert.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngZelle As Range, strText As String
Set Bereich = Intersect(Target, Range("D16:AV68"))
Select Case Target.Value
Case "A"
Target.Interior.ColorIndex = 4
Case "B"
Target.Interior.ColorIndex = 6
Case "C"
Target.Interior.ColorIndex = 8
Case "D".
.
.

Was müsste ich ändern das sich die Zellen nur innerhalb meiner Matrix verändern?

Gruß

 

Hallo,

indem Du den Select..End Select-Block mit folgender IF-Anweisung umschließst:

Code:

  If Not Bereich Is Nothing Then
  ...
  End If

und Bereich sollte als RANGE deklariert werden,
also:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rngZelle As Range, strText As String
  Dim Bereich as Range
  Set Bereich = Intersect(Target, Range("D16:AV68"))
  If Not Bereich Is Nothing Then
  Select Case Target.Value
    Case "A"
    Target.Interior.ColorIndex = 4
    Case "B"
    Target.Interior.ColorIndex = 6
    Case "C"
    Target.Interior.ColorIndex = 8
    Case "D"
  
  End Select
  End If
End Sub

EDIT:
Möchtest Du zusätzlich haben, dass Target vollständig in D16:AV68 enthalten sein muss (also teilweise Überschneidungen ausgeschlossen sein sollten), müsstest Du nach der IF-Anweisung noch eine zusätzliche Abfrage einfügen:
entweder:

Code:

IF Bereich.Address <> Target.Address THEN EXIT SUB
SELECT...
...
END SELECT
...

oder:

Code:

IF Bereich.Address = Target.Address THEN
  SELECT ...
  ...
  END SELECT
END IF

Es muss zu diesem Zweck "...Address" herangezogen werden, denn ein bloßer Vergleich von "Bereich" und "Target" (zB: IF Bereich=Target THEN...) scheitert, weil VBA hinter Bereich und Target automatisch die Standardeigenschaft (nämlich Bereich.VALUE und Target.VALUE) einsetzen würde.

 

Hallo Anton,

da hast Du dann einen entscheiden Vorteil des Makro entfernt. Es können nicht mehr mehrere Zellen mit einmal geändert werden und im Original Code war der Teil mit Nothing schon drin.

ich werde das Problem auch nicht vertiefen. Da halte ich mich an ein Zitat von meiner Homepage.

Gruß Hajo

 

Hallo!

@Hajo_Zi:
Da ich nicht wirklich weiß, was präzise Nadsat haben möchte und er die wesentliche Abfrage auf NOTHING entfernt hat, habe ich sie wieder eingefügt, da er offenbar doch die Einschränkung auf D16:AV68 haben möchte.

Die Funktion INTERSECT liefert als Ergebnis die Schnittmenge von TARGET und D16:AV68. Ist Target in D16:AV68 zur Gänze enthalten (auch wenn Target aus mehreren Zellen besteht), liefert Intersect wieder TARGET zurück. Somit ist in diesem Fall BEREICH und TARGET identisch.
Überschneidet jedoch TARGET den Bereich D16:AV68 nach außen hin, bedeutet das, dass der von INTERSECT zurückgelieferte Restberich (=BEREICH), der sich noch innerhalb von D16:AV68 befindet, kleiner sein muss als TARGET und sich somit BEREICH und TARGET im ADDRESS unterscheiden.
Es ist halt eine Frage, ob Nadsat diese vorgenannte Funktionalität haben möchte.

 

Hallo Anton,

es ist aber so das in Deinem Code mehrere Zellen in dem Bereich zu einem Fehler führt. Es ist ja möglich mehrere Zellen mit einmal zu ändern.

Gruß Hajo

 

Hallo!

Diese Aussage ist weder hilfreich noch zielführend noch rechtsrelevant/rechtsverbindlich...

Weder kannst du rechtlich nachweisen, dass diese Codes auf deinem "Mist" gewachsen sind, noch besitzen sie eine ausreichende Schöpfungshöhe, um überhaupt darauf ein Urheberrecht beanspruchen zu können.
Da helfen dir auch keine Copyright-Hinweise o.ä.

Ich akzeptiere dein Recht, dies als Abschreckung zu nutzen, aber in einem Hilfe-Forum ist dies mehr als fehl am Platz!!!
(Insbesondere dann, wenn du diese Codes auf deiner eigenen HP frei zugänglich und frei downloadbar machst...)

 

Hey Anton,

dank dir für den Hinweis. Die Matrix arbeitet nun so wie sie sollte.

 

ich wollte mich eines Kommentars zu dem Beitrag des Moderators eigentlich enthalten.
Aber wer Null Ahnung von VBA hat sollte keine Meinung dazu schreiben. Ich werde diese Disskussdion auch nicht weiter führen.

Gruß Hajo

 

Hallo!

Das wäre auch besser gewesen, denn hier geht es nicht um VBA-Kenntnisse, sondern um Kenntnisse zum Thema "Urheberrecht"!