Office: Wenn Zelle farbig, dann "x"

Matthias Kunz · 18. November 2012

Liebe VBA-Profis

Ich möchte gerne mittels Makro in Spalte E ein "x" geschrieben haben, wenn in der jeweiligen Zeile ab Spalte F eine x-beliebige Zelle farbig hinterlegt ist.

Wer könnte mir mit dem Code helfen?

Herzlichen Dank und beste Grüsse, Matthias

:)

IngGi · 20. November 2012

Hallo Matthias,

das geht zum Beispiel so:

'#######################################################
'# #
'# Code einfügen in: #
'# das Klassenmodul des betreffenden Tabellenblattes #
'# #
'#######################################################
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Sub FarbigeZellen()

Dim rngSpalte As Range
Dim rngZeile As Range
Dim blnFarbe As Boolean

For Each rngSpalte In Application.Intersect(Range("E:E"), Me.UsedRange)
For Each rngZeile In Application.Intersect(Range(rngSpalte.Offset(0, 1), _
Cells(rngSpalte.Row, Me.Columns.Count)), Me.UsedRange)

If rngZeile.Interior.ColorIndex <> -4142 Then
blnFarbe = True
Exit For
End If
Next 'rngZeile
If blnFarbe Then
rngSpalte = "x"
blnFarbe = False
End If
Next 'rngSpalte

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

VBA/HTML - CodeConverter für Excelforen
AddIn für Excel XP+2003 - komplett in VBA geschrieben von IngGi
Anbindung an VBE-Kontextmenü geklaut ;-) bei:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Matthias Kunz · 20. November 2012

Hallo Ingolf

Ganz herzlichen Dank für deine Hilfe!

Das Makro hängt sich bei „Me“ auf. Fehlermeldung: Fehler beim Kompilieren. Unzulässige Verwendung des Schlüsselworts Me.

Das Makro bezieht sich auf das Tabellenblatt „mit Zusatzstoffen“.

Kannst du mir bei der Anpassung des Codes nochmals helfen?

Vielen Dank und viele Grüsse - Matthias

Hajo_Zi · 20. November 2012

man könnte vermuten der Code ist nicht an der richtigen Stelle.
starte den VBA Editor (Alt+F11), Bild sollte zweigeteilt sein ansonsten Strg+R, Doppelklick auf Deine Datei, Doppelklick auf Deine Tabelle, Code ins rechte Fenster kopieren, VBA Editor schließen.

Matthias Kunz · 20. November 2012

Hallo Ingolf / Hallo Hajo

Jetz hat's geklappt. Vielen Dank. Jetz hab ich leider ein weiteres Problem. Die Zellen werden nämlich mittels "bedingter Formatierung" eingefärbt. Und leider reagiert das Makro darauf nicht. Wenn ich die Zellen manuell einfärbe, dann klappt's wunderbar. Wie kann ich das Makro bei bedingter Formatierung zum laufen bringen?

Tausend Dank für Eure Hilfe!

Beste Grüsse, Matthias

IngGi · 20. November 2012

Hallo Matthias,

in diesem Fall kannst du nicht die Farbigkeit der Zellen prüfen, sondern musst statt dessen dieselbe Bedingung prüfen, die du auch in der bedingten Formatierung verwendest. Da ich diese Bedingung nicht kenne, hier erstmal nur ein Beispiel:

Geprüft wird, ob die jeweilige Zelle einen Wert größer 100 enthält (Änderungen im Makro in rot):

Sub FarbigeZellen()

Dim rngSpalte As Range
Dim rngZeile As Range
Dim blnFarbe As Boolean

For Each rngSpalte In Application.Intersect(Range("E:E"), Me.UsedRange)
For Each rngZeile In Application.Intersect(Range(rngSpalte.Offset(0, 1), _
Cells(rngSpalte.Row, Me.Columns.Count)), Me.UsedRange)

If rngZeile.Value > 100 Then
blnFarbe = True
Exit For
End If
Next 'rngZeile
If blnFarbe Then
rngSpalte = "x"
blnFarbe = False
End If
Next 'rngSpalte

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

VBA/HTML - CodeConverter für Excelforen
AddIn für Excel XP+2003 - komplett in VBA geschrieben von IngGi
Anbindung an VBE-Kontextmenü geklaut ;-) bei:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Matthias Kunz · 20. November 2012

Hallo Ingolf

Vielen Dank nochmals! Die Zellen müssen geprüft werden, ob folgende Zahlen enthalten sind (die Zahlen sind in einem Text eingebunden; somit ist die Zahl nur ein Bestandteil des Zellinhalts):

124, 425, 555, 523, 522, 521, 520, 285, 284, 239, 235, 234, 228, 227, 226, 224, 223, 222, 221, 220, 219, 218, 217, 216, 215, 214, 213, 212, 211, 210, 321, 320, 316, 315, 312, 311, 310, 228, 227, 226, 224, 223, 222, 221, 220, 155, 154, 151, 142, 133, 132, 131, 129, 128, 127, 124, 122, 123, 110, 104, 102

Darf ich nochmals um deine Hilfe beim Code bitten?

Herzlichen Dank, Matthias

Hajo_Zi · 20. November 2012

Code:

Option Explicit

Sub FarbigeZellen()
Dim rngSpalte As Range
Dim rngZeile As Range
Dim blnFarbe As Boolean
For Each rngSpalte In Application.Intersect(Range("E:E"), Me.UsedRange)
For Each rngZeile In Application.Intersect(Range(rngSpalte.Offset(0, 1), _
Cells(rngSpalte.Row, Me.Columns.Count)), Me.UsedRange)
Select Case rngZeile.Value
Case 124, 425, 555, 523, 522, 521, 520, 285, 284, 239, 235, 234, 228, 227, _
226, 224, 223, 222, 221, 220, 219, 218, 217, 216, 215, 214, 213, 212, _
211, 210, 321, 320, 316, 315, 312, 311, 310, 228, 227, 226, 224, 223, _
222, 221, 220, 155, 154, 151, 142, 133, 132, 131, 129, 128, 127, 124, _
122, 123, 110, 104, 102
blnFarbe = True
Exit For
End Select
Next 'rngZeile
If blnFarbe Then
rngSpalte = "x"
blnFarbe = False
End If
Next 'rngSpalte
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Matthias Kunz · 20. November 2012

Hallo Hajo

Wenn die Zahlen in einen Text eingebunden sind, muss ich diese dann noch irgendwie markieren? Beispiel: die Zahl "300" ist in folgenden Zellentext eingebunden: Antioxidationsmittel E 300.

Nochmals ein herzliches Merci für deine Hilfe.

Matthias

Hajo_Zi · 20. November 2012

Hallo Matthias,

mit enthalten ist aufwendiger. Hier mal nur für 2.
Code:

Option Explicit

Sub FarbigeZellen()
Dim rngSpalte As Range
Dim rngZeile As Range
Dim blnFarbe As Boolean
For Each rngSpalte In Application.Intersect(Range("E:E"), Me.UsedRange)
For Each rngZeile In Application.Intersect(Range(rngSpalte.Offset(0, 1), _
Cells(rngSpalte.Row, Me.Columns.Count)), Me.UsedRange)
If InStr(rngZeile, 124) > 0 Then
blnFarbe = True
Exit For
ElseIf InStr(rngZeile, 425) > 0 Then
blnFarbe = True
Exit For
', 555, 523, 522, 521, 520, 285, 284, 239, 235, 234, 228, 227, _
226, 224, 223, 222, 221, 220, 219, 218, 217, 216, 215, 214, 213, 212, _
211, 210, 321, 320, 316, 315, 312, 311, 310, 228, 227, 226, 224, 223, _
222, 221, 220, 155, 154, 151, 142, 133, 132, 131, 129, 128, 127, 124, _
122, 123, 110, 104, 102
End If
Next 'rngZeile
If blnFarbe Then
rngSpalte = "x"
blnFarbe = False
End If
Next 'rngSpalte
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

IngGi · 20. November 2012

Hallo zusammen,

eine weitere Möglichkeit wäre es, die gesuchten Zahlen in ein Array zu schreiben und dieses dann bei der Prüfung zu durchlaufen:

Code:

Sub FarbigeZellen()

Dim rngSpalte As Range
Dim rngZeile As Range
Dim blnFarbe As Boolean
Dim arrZahlen(60) As Integer
Dim intElement As Integer

arrZahlen(0) = 124
arrZahlen(1) = 425
arrZahlen(2) = 555
arrZahlen(3) = 523
arrZahlen(4) = 522
arrZahlen(5) = 521
arrZahlen(6) = 520
arrZahlen(7) = 285
arrZahlen(8) = 284
arrZahlen(9) = 239
arrZahlen(10) = 235
arrZahlen(11) = 234
arrZahlen(12) = 228
arrZahlen(13) = 227
arrZahlen(14) = 226
arrZahlen(15) = 224
arrZahlen(16) = 223
arrZahlen(17) = 222
arrZahlen(18) = 221
arrZahlen(19) = 220
arrZahlen(20) = 219
arrZahlen(21) = 218
arrZahlen(22) = 217
arrZahlen(23) = 216
arrZahlen(24) = 215
arrZahlen(25) = 214
arrZahlen(26) = 213
arrZahlen(27) = 212
arrZahlen(28) = 211
arrZahlen(29) = 210
arrZahlen(30) = 321
arrZahlen(31) = 320
arrZahlen(32) = 316
arrZahlen(33) = 315
arrZahlen(34) = 312
arrZahlen(35) = 311
arrZahlen(36) = 310
arrZahlen(37) = 228
arrZahlen(38) = 227
arrZahlen(39) = 226
arrZahlen(40) = 224
arrZahlen(41) = 223
arrZahlen(42) = 222
arrZahlen(43) = 221
arrZahlen(44) = 220
arrZahlen(45) = 155
arrZahlen(46) = 154
arrZahlen(47) = 151
arrZahlen(48) = 142
arrZahlen(49) = 133
arrZahlen(50) = 132
arrZahlen(51) = 131
arrZahlen(52) = 129
arrZahlen(53) = 128
arrZahlen(54) = 127
arrZahlen(55) = 124
arrZahlen(56) = 122
arrZahlen(57) = 123
arrZahlen(58) = 110
arrZahlen(59) = 104
arrZahlen(60) = 102

For Each rngSpalte In Application.Intersect(Range("E:E"), Me.UsedRange)
For Each rngZeile In Application.Intersect(Range(rngSpalte.Offset(0, 1), _
Cells(rngSpalte.Row, Me.Columns.Count)), Me.UsedRange)

For intElement = 0 To UBound(arrZahlen)
If InStr(1, rngZeile.Value, arrZahlen(intElement)) > 0 Then
blnFarbe = True
Exit For
End If
Next 'intElement
If blnFarbe Then Exit For
Next 'rngZeile
If blnFarbe Then
rngSpalte = "x"
blnFarbe = False
End If
Next 'rngSpalte

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß Ingolf

Matthias Kunz · 20. November 2012

Hallo zusammen!

Vielen, vielen Dank nochmals; ihr habt mir beide sehr geholfen!!! :-)

Beste Grüsse - Matthias

Mark1965 · 16. Juni 2017

Hallo
Auch wenn der Thread schon 4 Jahre alt ist, mein Problem ist ähnlich.
Ich haben den Code von hier kopiert und nur das E:E gegen D*biggrin.gif* getauscht und anstelle "X" nun "Titel: " reingeschrieben.
Leider wird die gesamte Spalte D mit "Titel: " ausgefüllt.

Ich möchte das Wort "Titel: " in die Zelle der Spalte D stehen haben wo in der Spalte E eine gelb eingefärbte Zelle ist.
Z.B., wenn die Zelle E12 gelb ist, dass dann in D12 das Wort "Titel: " steht (+Schrift = fett)

geht das?
Für Eure Hilfe wäre ich dankbar.

Heimi65199 · 13. Januar 2018

Hallo zusammen,

ich denke mein Ansinnen ist ähnlich!

Ich möchte bei einer bestimmten Farbe (welche per VBA aus einem anderen Sheet übertragen wird) einer Spalte F einen bestimmten Text ausgeben.

Ich habe verschiedene Farben und dazugehörige verschiedene Texte!

Wie muss der Code hier angepasst werden!?

Ich komme leider nicht weiter mit den Farbcodes!

Kann mir jemand hierbei helfen!? Ich bin leider mit VBA und Makros nicht sonderlich "dicke" *wink.gif*

Vielen Dank für die Mühe!

Office: Wenn Zelle farbig, dann "x"

Wenn Zelle farbig, dann "x"

Wenn Zelle farbig, dann "x"

Wenn Zelle farbig, dann "x"

Wenn Zelle farbig, dann "x"

Wenn Zelle farbig, dann "x"

Wenn Zelle farbig, dann "x" - Similar Threads - Zelle farbig

Summieren farbiger Zahlen anhand des Farbcodes ohne VBA

Farbige Zellen in Zeilen addieren

Alle farbigen Zellen zählen.

farbige Zellen mittels Makro berücksichtigen

Farbige Zellen zählen

VBA Text in Zellen einfügen und farbigem Hintergrund

Zellen zusammen rechnen, wenn sie Farbig sind