Mit Makro formatieren bzw. Zelle wie eine andere Zelle mit gleichem Wert färben

[Schuedde]

Hallo Leute,

ich sitze an einer recht umfangreichen Tabelle für unsere Urlaubsübersicht und noch viel mehr. Hab euch hier mal eine Beispiel Übersicht gemacht wo alles für mein folgendes Thema drin ist.

Also, ich habe eine Tabelle "Abkürzungen" in der Kürzel stehen, für Abwesenheiten etc. Diese Kürzel wähle ich in den entsprechenden Monatstabellen per Dropdown aus und trage sie bei dem Mitarbeiter ein.
Die genannten Kürzel sind in der Tabelle Abkürzungen farbig hinterlegt. Die gleiche farbige Hinterlegung möchte ich gern jetzt z.B. im Juli bei dem Eintrag K für Krank drin haben. Weiterhin soll er die Zelle der Spalte Std mit einfärben, diese befindet sich direkt rechts daneben.

Ich weiß das es bedingte Formatierungen gibt, allerdings kommen bei uns immer mal wieder neue Kürzel dazu und andere werden wieder gelöscht. Jedesmal eine neue bedingte Formatierung dafür anzulegen ist zu aufwendig.
Daher hätte ich gern ein Makro, das einfach nach dem eingetragenen Status in der Tabelle Abkürzungen schaut und dann automatisch die Färbung in die Monats-Tabellen mit übernimmt. Ähnlich einer bedingten Formatierung halt. :19:

Ich denke das wird irgendwie funktionieren, aber ich finde einfach keinen Ansatz. Hoffe es kann mir jemand helfen, sollten fragen sein oder was undeutlich, immer raus damit, hab auch nochmal zwei Sätze mit in die Excel Mappe geschrieben...

Danke schonmal :15:

[AlterDresdner]

Hallo Schuedde,
wenn Du schon in mehreren Foren postest, dann sag das aber auch!
Gleicher Post findet sich bei Herber und ???

[Schuedde]

Wüsste nicht das da was dagegen spricht. Viele Quellen geben viele Ideen.
Aber ja, ich hab ich woanders gepostet. Hiermit angemeldet. 

Ne Lösung oder Hilfe wäre mir trotzdem lieber gewesen als nen uninteressanter Kommentar. Sowas macht Foren nämlich immer müßig wenn Sachen am Thema vorbei geschrieben werden....

[WillWissen]

Hallo Schuedde,

Wüsste nicht das da was dagegen spricht. Viele Quellen geben viele Ideen.

Bei uns ist das sogenannte Crossposting unter der Bedingung erlaubt, dass der Fragesteller seine Themen innerhalb der Foren verlinkt, damit die Helfer sich jeweils ein Bild vom Stand der Dinge machen können.
Lies dir dazu doch bitte einmal den Beitrag hinter diesem Link durch:  http://www.clever-excel-forum.de/misc.php?action=help&hid=10

[Schuedde]

Ah alles klar, dann lag es an meiner Unwissenheit. Werde ich in Zukunft beachten. Aber ich würde es eh als erledigt markieren, wenn ich ne Lösung habe. Und natürlich die Lösung dazu setzen.

wenn man es passend formuliert, versteht es der andere auch nicht falsch.  :05: Danke für die Klarstellung

[steve1da]

Hola,

das Problem ist, dass du mehrere Foren beschäftigst, ohne dass diese voneinander wissen. Das verursacht unnötige Doppelarbeit.
Eine Lernkurve ist übrigens nicht zu erkennen:

http://www.vba-forum.de/forum/View.aspx?...%C3%A4rben

Gruß,
steve1da

[Schuedde]

Ich hab es in 4 Foren zeitnah reingestellt, da ich hier mitmögen letzten malen kein Erfolg hatte. 
Bei MS Office ist es auch drin.

Aber ich sehe nicht von doppelarbeit außer der Tatsache das ihr alle beschäftigt seid meine Posts zu suchen. Ich sehe da immer noch k in Problem. Zukünftig werde ich mich dran halten, aber mehr Posts am Thema vorbei müssen nun auch nicht mehr sein. Wenn ich hierzu irgendwo anders eine Lösung finde, poste ich diese hiermit und markiere es als erledigt. Also sobald jemand eine Lösung hat bekommt es jeder mit und es ist in allen Foren abgeschlossen.keine doppelarbeit!!!

[Schuedde]

So um alle zu beruhigen, es ist erledigt, habe im MS Office Forum ne Antwort bekommen. Hier die Lösung

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   Dim rngZelle As Range
   Dim rngFarbe As Range
   
 

   If Sh.Name <> "Abkürzung" Then
       For Each rngZelle In Selection
           If Cells(3, rngZelle.Column) = "Kürzel" Then
               
               Set rngFarbe = Worksheets("Abkürzung").Columns(1).Find(rngZelle.Value, lookat:=xlWhole)
               
               Cells(rngZelle.Row, rngZelle.Column + 1).Interior.Color = rngFarbe.Interior.Color
               
               If Not rngFarbe Is Nothing Then
                   rngZelle.Interior.Color = rngFarbe.Interior.Color
               Else
                   MsgBox "Kürzel nicht gefunden"
               End If
           End If
           
         
                   
       Next rngZelle
   End If
   Set rngFarbe = Nothing
   
     
End Sub