Bedingte Formatierung VBA mehrere Zellen

Computer: Software & Programmierung Office Software
1

Hallo,

ich war auf der Suche nach einer Möglichkeit eine bedingte Formatierung mit mehr als drei Bedingungen zu generieren. Im Archiv (31.10.2003) habe ich den VBA-Code von Reinhard (Danke schon mal dafür) gefunden:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address(False, False) „B1“ Then Exit Sub
Select Case Range(„B1“)
Case „A“
Range(„D1“).Interior.ColorIndex = 5 'blaue Fläche
Range(„D1“).Font.ColorIndex = 2 'weiße Schrift
Range(„D1“).Value = „Auto“
Case „F“
Range(„D1“).Interior.ColorIndex = 4 'grün
Range(„D1“).Font.ColorIndex = 1 'schwarz
Range(„D1“).Value = „Fahrrad“
Case „X“
Range(„D1“).Interior.ColorIndex = 7
Range(„D1“).Font.ColorIndex = 12
Range(„D1“).Value = „Roller“
Case „Y“
Range(„D1“).Interior.ColorIndex = 23
Range(„D1“).Font.ColorIndex = 37
Range(„D1“).Value = „Skibob“
Case „Z“
Range(„D1“).Interior.ColorIndex = 36
Range(„D1“).Font.ColorIndex = 0
Range(„D1“).Value = „Vipschaukel“
Case Else
Range(„D1“).Interior.ColorIndex = xlNone 'keine
Range(„D1“).Font.ColorIndex = 0 'automatisch
'Range(„D1“).Value = „“
End Select
End Sub

Funktioniert auch super. Nun ist mein Problem etwas anders. Ich möchte z.B. die Zellen A10 bis A30 abfragen und die Formatierung dann auch in diesem Feld sehen. Müsste also wahrscheinlich noch eine Schleife eingebaut werden à la gucke in A10 und passe die Formatierung an, gucke dann in A11 und passe die Formatierung an usw.
Vermute, es ist für VBA-Kenner kein Problem, ich selbst habe damit noch nie was gemacht. EIne idiotensichere Erklärung wäre somit für mich sehr hilfreich.

Danke und Grüße
Anja

2

also wenns eine einmalige Sache ist, dann geh einfach mit F2-Enter-F2-Enter-F2-Enter usw durch…

wenn es was mehrmaliges ist dann bau Dir eine Schleife, in der du die Werte der betroffenen Zellen ausliest und sie gleich wieder setzt.
Das Makro ändern würde ich eigentlich nicht :smile:

3

Funktioniert auch super. Nun ist mein Problem etwas anders.
Ich möchte z.B. die Zellen A10 bis A30 abfragen und die
Formatierung dann auch in diesem Feld sehen. Müsste also
wahrscheinlich noch eine Schleife eingebaut werden à la gucke
in A10 und passe die Formatierung an, gucke dann in A11 und
passe die Formatierung an usw.
Vermute, es ist für VBA-Kenner kein Problem, ich selbst habe
damit noch nie was gemacht. EIne idiotensichere Erklärung wäre
somit für mich sehr hilfreich.

Hi Anja,
welche Zelle(n) sollen denn formatiert werden je nach Werten in A10:A30?
Wenn D1 dann ungetestet evtl. so:

Option Explicit
Option Base 1 'array beginnt bei index 1 , nicht wie Standard bei 0
Private Sub Worksheet\_Change(ByVal Target As Excel.Range)
'nichts machen wenn keine Einzelzelle sonder Zellenbereich kopiert o.ä wurde
If Target.Cells.Count 1 Then Exit Sub
' wenn Zellenänderung in A1:A30 dann...
If Not Intersect(Target, Range("A10:A30")) Is Nothing Then
 such = "AFXYZ"
 'bedingt durch seine Position in such ist jedem Buchstaben eine farbe, Schrift, Wert zugeordnnet
 Fläche = Array(5, 4, 7, 23, 36, xlNone)
 Schrift = Array(2, 1, 12, 37, 0, 0)
 Wert = Array("Auto", "Fahrrad", "Roller", "Skibob", "Vipschaukel", "")
 pos = InStr(such, Target)
 If pos = 0 Then pos = 6
 Range("D1").Interior.ColorIndex = Fläche(pos)
 Range("D1").Font.ColorIndex = Schrift(pos)
 Range("D1").Value = Wert(pos)
End If
End Sub

Gruß
Reinhard

4

Hallo Reinhard,

habe deinen Code ausprobiert und er meckert bei Private Sub…

Die Formatierung sollte eigentlich in der Zelle angezeigt werden, in der auch die Bedingung steht.
Ich erzeuge in den Zellen A10-A30 (bleiben wir mal bei den Beispiel) über Wenn-Bedingungen Buchstaben, die dann eine bestimmte Formatierung haben sollen. -->
A10=A
A11=F
A12=X
A13=A
A14=F usw.
Daraus sollte dann folgen A10 wird weiße Schrift und blaue Fläche, A11 ist grün schwarz… (wie in deinem Beispiel angenommen)
Die Zellen können sich ändern, dann steht in A10 F und die Formatierung sollte sich dann auch anpassen.

grüße Anja

5

Hi Anja,

habe deinen Code ausprobiert und er meckert bei Private Sub…

ja, wahrscheinlich wegen fehlender Dim’s

Die Formatierung sollte eigentlich in der Zelle angezeigt
werden, in der auch die Bedingung steht.
Ich erzeuge in den Zellen A10-A30 (bleiben wir mal bei den
Beispiel) über Wenn-Bedingungen Buchstaben, die dann eine
bestimmte Formatierung haben sollen. -->

Das ist ein Problem, Worksheet_Change reagiert nur bei manuellen Zelländerungen, Änderungen durch Formeln werden nicht als Erignis wahrgenommen.
Also müssen in Worksheet_cahnge alle zellen überrwacht werden, die manuell verändert werden und die dann über Wenn-Dann in A10:A30 die Werte ändern.
Wenn dann einer dieser „anderen“ Werte manuell geändert wurde, muss über eine Schleife jede zelle in A10:A30 überprüft werden und ggfs anders formatiert.
Hier wird C10:C30 und F7 „überwacht“:

Option Explicit
Option Base 1 'array beginnt bei index 1 , nicht wie Standard bei 0

Private Sub Worksheet\_Change(ByVal Target As Excel.Range)
If Target.Cells.Count 1 Then Exit Sub
If Not Intersect(Target, Range("C10:C30")) Is Nothing Or Target.Address(0, 0) = "F7" Then
 Call pruef
End If
End Sub

Sub pruef()
Dim such As String, Fläche(), Schrift(), pos As Byte
such = "AFXYZ"
Fläche = Array(5, 4, 7, 23, 36, xlNone)
Schrift = Array(2, 1, 12, 37, 0, 0)
For n = 10 To 30
 pos = InStr(such, Range("A" & n))
 If pos = 0 Then pos = 6
 Range("A" & n).Interior.ColorIndex = Fläche(pos)
 Range("A" & n).Font.ColorIndex = Schrift(pos)
Next n
End Sub

Man könnte auch Worksheet_Calculate ausnutzen und da
call pruef
reinschreiben, kannste ja mal testen, ich muss jetzt weg.
Gruß
Reinhard

6

Hallo,

diesmal meckert er bei „Sub pruef…“

Ich glaube ich löse mein „Problem“ jetzt ganz anders.
Es ist einfach zu kompliziert für mich, da ich von VBA so gar keine Ahnung habe und wenn ich mal was anpassen will, deinen Code nicht selbst anpassen kann, weil ich von keinem Befehl eine Ahnung habe, was er heißt.
Also werde ich vielleicht mal versuchen mich an einfachen Dingen in VBA auszuprobieren und mich irgendwie zu steigern.

Grüße und Danke für deine Hilfe
Anja

7

Hi Anja,
schau mal da bitte:
http://www.badongo.com/file.php?file=jetzt+aber±g__…
Gruß
Reinhard