Zellfarbe UND Inhalt aus Dropdown

Hi
Ich habe folgendes Problem, für das ich trotz längerer Suche noch immer keine Lösung gefunden habe und hoffe, es gibt jemand hier, der einen Idee für die Lösung des Problems hat.
Ich habe eine Datenblatt mit dem Namen DropDown, in der wie im angehängten Beispiel 100 Zellen in einer Spalte mit unterschiedlichen Farben, die alle im RGB-Wert angegeben wurden und den zur Farbe dazugehörenden Name erstellt.
Nun möchte ich über ein Dropdown-Menü auf einem weiteren Tabellenblatt, nicht nur den Text aus der gewählten Dropdown-Zelle übernehmen, sondern auch die dort entsprechend angelegte Zellfarbe.
Ich hatte mir überlegt, dies über Wenn-Dann zu machen, aber ich habe keine Ahnung ob ich die Wenn-Dann-Funktion soweit erweitern kann und ich möchte dann später in einer weiteren Spalte 160 weitere Farben anlegen.
Gibt es dazu eine Lösung?
https://www.herber.de/bbs/user/143457.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$F$3" Then With Worksheets("DropDown") Dim Rafound As Range Set Rafound = .Columns(1).Find(Target, .Range("A1"), , xlPart, , xlNext) If Not Rafound Is Nothing Then Target.Interior.Color = Rafound.Interior.Color Else Target.Interior.ColorIndex = xlNone End If End With End If End Sub

Hallo Andreas,
Rechtsklick auf den Tabellenreiter - Code anzeigen. Folgende Prozedur einfügen:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim objRange As Range, objCell As Range, objSearchCell As Range
    Set objRange = Intersect(Target, Columns(6))
    If Not objRange Is Nothing Then
        For Each objCell In objRange
            With objCell
                If .Row > 1 Then
                    If Not IsEmpty(.Value) Then
                        Set objSearchCell = Worksheets("DropDown").Columns(1).Find( _
                            What:=.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                        If Not objSearchCell Is Nothing Then
                            .Interior.Color = objSearchCell.Interior.Color
                            Set objSearchCell = Nothing
                        End If
                    Else
                        .Interior.Pattern = xlPatternNone
                    End If
                End If
            End With
        Next
        Set objRange = Nothing
    End If
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Zellfarbe UND Inhalt aus Dropdown

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread