Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Zellen nach farbe abfragen
Gehe zu Seite 1, 2  Weiter
zurück: Zugriff auf einen manuell erstellten Registry Wert weiter: Bekomme Select Case Anweisung nicht hin Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Feedback Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
StreunerKA
Einsteiger


Verfasst am:
11. Jun 2011, 14:30
Rufname:

Zellen nach farbe abfragen - Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Hallo,

ich möchte gerne verschieden Zellen nach der Farbe schwarz abfragen und dann in einer bestimmten Zelle eine Farbe eintragen.
z.B. wenn in Zelle B1 oder B4 oder B7 schwarz ist dann soll Zelle B20 auch schwarz werden. Wenn keine oder andere Farbe dann mache nichts.

_________________
Gruß
StreunerKA
slowboarder
Im Profil kannst Du frei den Rang ändern


Verfasst am:
11. Jun 2011, 14:36
Rufname:


AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Hi

Code:
Sub Farbe()
Dim Zelle As Range
Const FarbID = 1 'Farbindex für Schwarz, falls nicht bitte anpassen

For Each Zelle In Range("B1,B4,B7")
   If Zelle.Interior.ColorIndex = FarbID Then
       Range("B20").Interior.ColorIndex = FarbID
       Exit For
   End If
Next

End Sub


Gruß, Daniel
StreunerKA
Einsteiger


Verfasst am:
11. Jun 2011, 14:50
Rufname:

AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Hallo Daniel,

genau das suche ich. Very Happy
Wollte jetzt noch ein ELSE hinzufügen damit beim Ändern die Farbe wieder weg geht, und nun geht es nicht mehr.
Hab anscheinend einen kleinen Fehler im Code.
Kann du bitte mal schauen.

DANKE

Code:
Sub Farbe()
Dim Zelle As Range
Const FarbID1 = 1 'Farbindex für Schwarz, falls nicht bitte anpassen
Const FarbID2 = 0 'Farbindex für keine Füllung, falls nicht bitte anpassen

For Each Zelle In Range("B1,B4,B7")
   If Zelle.Interior.ColorIndex = FarbID1 Then
       Range("B20").Interior.ColorIndex = FarbID1
       Else
       Range("B20").Interior.ColorIndex = FarbID2
       Exit For
   End If
Next

End Sub

_________________
Gruß
StreunerKA
slowboarder
Im Profil kannst Du frei den Rang ändern


Verfasst am:
11. Jun 2011, 14:54
Rufname:

AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Hi
also mit if then ELSE funktioniert das konstrukt so nicht.
setz einfach B20 vorher auf die Farbe, die B20 bekommen soll, wenn keine der genanten Zellen schwarz ist.
Gruß, Daniel
StreunerKA
Einsteiger


Verfasst am:
11. Jun 2011, 15:23
Rufname:


AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Hallo Daniel,

leider geht es so nicht.
Es müsste sich im Nachhinein, wenn ich die Farbe schwarz z.B. in B4 entferne auch die Farbe schwarz in B20 entfernen, natürlich nur wenn in B1 und B7 nicht die Farbe schwarz ist.

_________________
Gruß
StreunerKA
slowboarder
Im Profil kannst Du frei den Rang ändern


Verfasst am:
11. Jun 2011, 15:28
Rufname:

AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Hi

das funktioniert schon so.
mein Makro färbt die Zelle B20 schwarz, wenn mindestens eine der Genannten Zellen schwarz ist.
Ist keine der geannenten Zellen schwarz, behält B20 die Farbe, die es vorher hatte.
Wenn also B20 weiß werden soll, wenn keine der geannten Zellen schwarz ist, musst du einfach nur vorher B20 weiß machen und dann mein Makro laufen lassen.

Gruß, Daniel
StreunerKA
Einsteiger


Verfasst am:
11. Jun 2011, 15:34
Rufname:

AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Hi,

leider geht es bei mir nicht so.
Oder meine ich was anderes?
Ich habe es nun nochmals versucht.
Ich mache die Zelle B4 schwarz und lasse das Makro laufen dann wird die Zelle B20 schwarz. Das ist so genau richtig (Perfekt).
Danach mache ich die Zelle B4 weiß oder auf eine andere Farbe und die Zelle B20 bleibt trotzdem schwarz und ich bräuchte es so dass sie wieder weiß wird weil ja alle 3 Zellen kein schwarz mehr besitzen.

_________________
Gruß
StreunerKA
StreunerKA
Einsteiger


Verfasst am:
11. Jun 2011, 16:28
Rufname:

AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Hallo,

hab eine Lösung gefunden. Very Happy
Ich habe nun den Code so geschrieben und es funktioniert.

Code:

Sub Farbe()
Const FarbID1 = 1 'Farbindex für Schwarz
Const FarbID2 = 0 'Farbindex für keine Füllung


    If Range("B1").Interior.ColorIndex = FarbID1 Then GoTo Farbe1

    If Range("B4").Interior.ColorIndex = FarbID1 Then GoTo Farbe1

    If Range("B7").Interior.ColorIndex = FarbID1 Then GoTo Farbe1
   
    Range("B20").Interior.ColorIndex = FarbID2
   
    GoTo Farbe0

Farbe1:       Range("B20").Interior.ColorIndex = FarbID1

Farbe0:

End Sub

_________________
Gruß
StreunerKA
gandalf149
Im Profil kannst Du frei den Rang ändern


Verfasst am:
11. Jun 2011, 17:57
Rufname:
Wohnort: Fiersbach

AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Hallo StreunerKA

oder so

Code in die Tabelle

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim FarbID1
Dim FarbID2
FarbID1 = 1
FarbID2 = xlNone
If ActiveSheet.Range("B1").Interior.ColorIndex = FarbID1 Or ActiveSheet.Range("B4").Interior.ColorIndex = FarbID1 Or ActiveSheet.Range("B7").Interior.ColorIndex = FarbID1 Then
ActiveSheet.Range("B20").Interior.ColorIndex = FarbID1
Else
ActiveSheet.Range("B20").Interior.ColorIndex = FarbID2
End If
End Sub


dann geht es automatisch bei Zellenselection

Gruß Gandalf149

_________________
Jedes Kind ist ein Künstler. Das Problem ist nur, wie man einer bleibt, wenn man erwachsen wird.
Pablo Picasso
StreunerKA
Einsteiger


Verfasst am:
11. Jun 2011, 18:14
Rufname:

AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Hallo Gandalf149,

genau das ist es. Very Happy

Vielleicht könntest du mir noch mal helfen.
Wenn ich es jetzt noch auf mehrere Spalten verteilen möchte,
muss ich das dann so machen?
Oder gibt es noch eine elegantere Lösung?
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim FarbID1
Dim FarbID2

FarbID1 = 1
FarbID2 = xlNone

If ActiveSheet.Range("A1").Interior.ColorIndex = FarbID1 Or ActiveSheet.Range("A4").Interior.ColorIndex = FarbID1 Or ActiveSheet.Range("A7").Interior.ColorIndex = FarbID1 Then
ActiveSheet.Range("A20").Interior.ColorIndex = FarbID1
Else
ActiveSheet.Range("A20").Interior.ColorIndex = FarbID2
End If

If ActiveSheet.Range("B1").Interior.ColorIndex = FarbID1 Or ActiveSheet.Range("B4").Interior.ColorIndex = FarbID1 Or ActiveSheet.Range("B7").Interior.ColorIndex = FarbID1 Then
ActiveSheet.Range("B20").Interior.ColorIndex = FarbID1
Else
ActiveSheet.Range("B20").Interior.ColorIndex = FarbID2
End If

If ActiveSheet.Range("C1").Interior.ColorIndex = FarbID1 Or ActiveSheet.Range("C4").Interior.ColorIndex = FarbID1 Or ActiveSheet.Range("C7").Interior.ColorIndex = FarbID1 Then
ActiveSheet.Range("C20").Interior.ColorIndex = FarbID1
Else
ActiveSheet.Range("C20").Interior.ColorIndex = FarbID2
End If

End Sub

_________________
Gruß
StreunerKA
KeepCoolMan
VBA-NonExpert ;) Office 2010


Verfasst am:
11. Jun 2011, 18:40
Rufname: Thomas
Wohnort: Celle

AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Mal ein Vorschlag auf die Schnelle...

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim FarbID1, FarbID2
    FarbID1 = 1
    FarbID2 = xlNone
    checkRange "A1,A4,A7", FarbID1, "A20", FarbID2
    checkRange "B1,B4,B7", FarbID1, "B20", FarbID2
    checkRange "C1,C4,C7", FarbID1, "C20", FarbID2
End Sub

' prüft Zellen auf checkColor. Ist min eine Zelle checkColor, dann wird targetRange auch checkColor, sonst notCheckedColor
' Die Adressen der Zellen werden als String übergeben!
Private Sub checkRange(adressen As String, ByVal checkColor As Integer, targetRange As String, ByVal notCheckedColor As Integer)
    Dim r, c
    Dim toSet As Boolean
    r = Split(adressen, ",")
    For Each c In r
        If Range(c).Interior.ColorIndex = checkColor Then toSet = True
    Next
    Range(targetRange).Interior.ColorIndex = IIf(toSet, checkColor, notCheckedColor)
End Sub


So lassen sich auch beliebige Farben für jeden Bereich verwenden...

_________________
Gruß Thomas

Ich freue mich über Feedback, Kritik und Verbesserungsvorschläge...
Wer will, findet Möglichkeiten; wer nicht will, findet Gründe! :: Unt wär Rächdshraibfela fint, daaf sie behaltn!
StreunerKA
Einsteiger


Verfasst am:
11. Jun 2011, 19:01
Rufname:

AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Hallo alle zusammen,

ich bin begeistert.
Hab Thomas seinen Code getestet und er funktioniert natürlich.
Jetzt habe ich natürlich noch weitere Fragen. Embarassed
Dieser Code hilft mir in meinem Excel Kalender (ich arbeite viel mit Farben) in einem Zeitstrahl in der „Zeile 20“ zu sehen wann ich Termine habe.
Nun möchte ich den Code über das ganze Jahr ziehen.
Kann man das auch noch optimieren?
Oder muss ich jede einzelne Zeile extra aufführen?

So wie hier im Beispiel Code:
Code:
checkRange "A1,A4,A7", FarbID1, "A20", FarbID2
checkRange "B1,B4,B7", FarbID1, "B20", FarbID2
checkRange "C1,C4,C7", FarbID1, "C20", FarbID2
checkRange "D1,D4,D7", FarbID1, "D20", FarbID2
checkRange "E1,E4,E7", FarbID1, "E20", FarbID2
...

_________________
Gruß
StreunerKA
KeepCoolMan
VBA-NonExpert ;) Office 2010


Verfasst am:
11. Jun 2011, 19:38
Rufname: Thomas
Wohnort: Celle

AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Wenn die Zeilen immer gleich sind, dann kannst du den checkRange-Aufruf in eine Schleife packen: (das Beispiel geht davon aus, das der erste Tag in Spalte 1 ist und alle Tage lückenlos nebeneinander angeordnet sind)

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim FarbID1, FarbID2
    FarbID1 = 1
    FarbID2 = xlNone
    Dim s As Integer, c As String
    For s = 1 To 365
        c = Replace(Chr((s - 1) \ 26 + 64) & Chr((s - 1) Mod 26 + 65), "@", "")
        checkRange Replace("_1,_4,_7", "_", c), FarbID1, Replace("_20", "_", c), FarbID2
    Next
End Sub


Mehr brauchst du dann nicht ändern...

_________________
Gruß Thomas

Ich freue mich über Feedback, Kritik und Verbesserungsvorschläge...
Wer will, findet Möglichkeiten; wer nicht will, findet Gründe! :: Unt wär Rächdshraibfela fint, daaf sie behaltn!
StreunerKA
Einsteiger


Verfasst am:
11. Jun 2011, 19:47
Rufname:

AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Hallo Thomas,

leider geht der Code so bei mir nicht.

Hier bringt er mir Fehler.
Code:
If Range(c).Interior.ColorIndex = checkColor Then toSet = True


Und hier der ganze Code
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
    Dim FarbID1, FarbID2
    FarbID1 = 1
    FarbID2 = xlNone
    Dim s As Integer, c As String
   
    For s = 1 To 365
        c = Replace(Chr((s - 1) \ 26 + 64) & Chr((s - 1) Mod 26 + 65), "@", "")
        checkRange Replace("_1,_4,_7", "_", c), FarbID1, Replace("_20", "_", c), FarbID2
    Next
   
End Sub

' prüft Zellen auf checkColor. Ist min eine Zelle checkColor, dann wird targetRange auch checkColor, sonst notCheckedColor
' Die Adressen der Zellen werden als String übergeben!

Private Sub checkRange(adressen As String, ByVal checkColor As Integer, targetRange As String, ByVal notCheckedColor As Integer)
   
    Dim r, c
    Dim toSet As Boolean

   
    r = Split(adressen, ",")
    For Each c In r
        If Range(c).Interior.ColorIndex = checkColor Then toSet = True
    Next
    Range(targetRange).Interior.ColorIndex = IIf(toSet, checkColor, notCheckedColor)
   
End Sub

_________________
Gruß
StreunerKA
KeepCoolMan
VBA-NonExpert ;) Office 2010


Verfasst am:
11. Jun 2011, 20:18
Rufname: Thomas
Wohnort: Celle


AW: Zellen nach farbe abfragen - AW: Zellen nach farbe abfragen

Nach oben
       Version: Office 2003

Sorry, mein Fehler!
Hatte nicht auf deine Excel-Version geachtet. Bei dir ist bei 256 Spalten Ende Sad
D.h., die Schleife muss natürlich so lauten:
Zitat:
For s = 1 To 256
c = Replace(Chr((s - 1) \ 26 + 64) & Chr((s - 1) Mod 26 + 65), "@", "")
checkRange Replace("_1,_4,_7", "_", c), FarbID1, Replace("_20", "_", c), FarbID2
Next

_________________
Gruß Thomas

Ich freue mich über Feedback, Kritik und Verbesserungsvorschläge...
Wer will, findet Möglichkeiten; wer nicht will, findet Gründe! :: Unt wär Rächdshraibfela fint, daaf sie behaltn!
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Gehe zu Seite 1, 2  Weiter
Diese Seite Freunden empfehlen

Seite 1 von 2
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: Datum aus mehreren Zellen zusammensetzen. 9 gast2005 5086 25. Dez 2004, 22:33
Kuwe Datum aus mehreren Zellen zusammensetzen.
Keine neuen Beiträge Excel Formeln: Leere Zellen ignorieren! 1 Gast 2485 24. Dez 2004, 00:59
xyzdef Leere Zellen ignorieren!
Keine neuen Beiträge Excel Formeln: Teile aus Zellen ersetzen und kopieren?? 2 Marbi 1145 03. Dez 2004, 14:49
Gast Teile aus Zellen ersetzen und kopieren??
Keine neuen Beiträge Excel Formeln: Berechnung mit ausgeblendeten Zellen 2 Urban 1123 11. Nov 2004, 08:25
Günni Berechnung mit ausgeblendeten Zellen
Keine neuen Beiträge Excel Formeln: WENN und Textteil abfragen...?!? 2 derschroe 515 03. Nov 2004, 16:35
derschroe WENN und Textteil abfragen...?!?
Keine neuen Beiträge Excel Formeln: 2 oder mehr zellen verbinden, nicht VERKETTEN mit & 5 ALEKS 3246 28. Okt 2004, 10:55
Aleks 2 oder mehr zellen verbinden, nicht VERKETTEN mit &
Keine neuen Beiträge Excel Formeln: Gelbe Zellen zählen! 6 Axis_Sonnenflieger 4453 27. Okt 2004, 14:50
Axis_Sonnenflieger Gelbe Zellen zählen!
Keine neuen Beiträge Excel Formeln: Summe verschiedener Zellen mit Suchkreterium (sverweis) 3 Ralli 11135 13. Okt 2004, 23:12
ae Summe verschiedener Zellen mit  Suchkreterium (sverweis)
Keine neuen Beiträge Excel Formeln: verknüpfung verschiedener zellen in verschiedenen tabellen 4 urlachs 3695 23. Sep 2004, 22:43
urlachs verknüpfung verschiedener zellen in verschiedenen tabellen
Keine neuen Beiträge Excel Formeln: Nichtleere Zellen zählen 2 Gast 2690 21. Sep 2004, 10:37
Gast Nichtleere Zellen zählen
Keine neuen Beiträge Excel Formeln: In Zellen nach mehreren 'Strings' suchen... 4 Schmalhans 2373 16. Sep 2004, 12:45
Schmalhans In Zellen nach mehreren 'Strings' suchen...
Keine neuen Beiträge Excel Formeln: Kopieren von Zellen, Problem mit Datumsformatierung 4 Mick 1431 08. Sep 2004, 18:59
Mick Kopieren von Zellen, Problem mit Datumsformatierung
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Dreamweaver Forum