Office: Meherer Zellen mit VBA farbig markieren

HilfeProblem · 22. Januar 2013

Hallo,

ich habe ein Problem.
vereinfacht dargestellt habe ich zwei arbeitsblätter.
in dem einem (Daten) kann man Monate von 2013 bis 2014 auswählen.
Anhand der ausgewählten Monate sollen die enstprechenden Zellen in dem anderen Arbeitsblatt (Visuell) von Monat x bis Monat y eingefärbt werden. Jeder Monat hat ein Zelle.
Erschwerend kommt hinzu, dass sich der Schaltknopf des VBA in Arbeitsblatt Visuell befindet und die Daten im Arbeitsblatt "Daten" sind.

Mein Code hierzu lautet:

Worksheets("Visuell").Range("Worksheets("Visuell").Range("A108"):worksheets("visuell").Range("B108")")).Interior.Color = RGB(Worksheets("Daten").Range("P3"), Worksheets("Daten").Range("Q3"), Worksheets("Daten").Range("R3"))

Ich hoffe Ihr könnt mir helfen
Vielen Dank für Euro Hilfe =)

:)

Hasso · 28. Januar 2013

Hallo HilfeProblem,

aus deinem Code werde ich nicht schlau: Code:

Worksheets("Visuell").Range("Worksheets("Visuell").Range("A108"):worksheets("visuell").Range("B108")")).Interior.Color = RGB(Worksheets("Daten").Range("P3"), Worksheets("Daten").Range("Q3"), Worksheets("Daten").Range("R3"))
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mein gerne wiederholter Tipp: Das Hochladen einer Beispieldatei, gerne auch mit anonymisierten Daten, in der zu sehen ist, worin das Problem besteht und wie das Ergebnis aussehen soll, erhöht die Chance auf eine befriedigende Antwort ungemein!

HilfeProblem · 21. Februar 2013

Hallo,

ich stelle meine Frage nun etwas anders.

Ich habe folgenden Code:

Private Sub CommandButton1_Click()

Dim JAN As String
JAN = Range("CC4").Value
Dim APR As String
APR = Range("CF4").Value

Range("JAN:APR").Interior.Color = RGB(192, 192, 192)

End Sub

Frage: In Zelle CC4 steht Januar2013 (Monate können geändert werden)
In Zelle CF4 steht April 2016 (Monate können geändert werden)

Ich möchte das in einer unter dem Eingabefeld stehenden Tabelle (ist ein Kalender) nun die Monate Januar2013 bis April2016 farbig markiert werden.

Mein Code zeigt keinen fehler an. Er markiert aber auch nichts.

Könnt ihr mir helfen?

Vielen Dank schonaml für eure antworten

Hasso · 21. Februar 2013

Code:

Range("JAN:APR").Interior.Color = RGB(192, 192, 192)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Den Code verstehe ich leider nicht. Bei einer Range kannst du in Anführungszeichen einen Zellbereich angeben, z.B. ActiveSheet.Range("CC4:CF4").
Du könntest auch einen Bereichsnamen verwenden, z.B. Code:

Range("CC4:CF4").name="Eingabebereich"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

und dich dann mit Code:

ActiveSheet.[Eingabebereich]
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

darauf beziehen, aber so etwas wie Range("JAN:APR") ergibt keinen Sinn.

Ich möchte das in einer unter dem Eingabefeld stehenden Tabelle (ist ein Kalender) nun die Monate Januar2013 bis April2016 farbig markiert werden.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Was für ein Eingabefeld? Was hat das mit dem Code zu tun, den du gepostet hast?

Mein Code zeigt keinen fehler an. Er markiert aber auch nichts
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Da wir deine Tabelle nicht sehen, können wir nur raten.

Warum sperrst du dich so dagegen, eine Beispieltabelle hochzuladen? Dann könnte man dir vielleicht helfen, aber so kann mit deinen Angaben niemand etwas anfangen.

HilfeProblem · 21. Februar 2013

Hallo,

so jetzt habe ich auch eine Beispieldatei.
Ich hoffe dadurch wird es etwas klarer, was ich machen möchte*wink.gif* . Habe Anmerkungen in die Datei geschrieben. Glaube dadurch ist es ersichtlich.
Vielen Dank schonmal für Deine bisherigen Tipps.
Vielleicht kannst du mir ja nochmal helfen.

Danke und Gruß

Hasso · 21. Februar 2013

Hallo HilfeProblem,

Das Hauptproblem bei der Lösung deines Problems sind wieder mal verbundene Zellen, die jeder Excel-Profi wie die Pest hasst.

Ich habe mal in deinem Zielbereich, der eingefärbt werden soll, bei den Jahreszahlen die Zellverbindung aufgehoben und die Jahreszahl jedes mal direkt über den Monat geschrieben. Dann ist das ein Klacks:
Code:

Private Sub CommandButton1_Click()

Dim rngZelle As Range
Dim dteStartdatum As Date
Dim dteEnddatum As Date
Dim dteTermindatum As Date
Dim strFarbe As String
Dim intRot As Integer
Dim intGruen As Integer
Dim intBlau As String
Dim intSpalte As Integer

Worksheets("Visuell").Range("C51:DF90").Name = "Zielbereich"
Worksheets("Farbcodes").Range("A2:D57").Name = "farbtabelle"
dteStartdatum = DateValue(1 & "." & Left(Range("C3"), 3) & " " & Right(Range("C3"), 2))
dteEnddatum = DateValue(1 & "." & Left(Range("F3"), 3) & " " & Right(Range("F3"), 2))
strFarbe = Worksheets("Visuell").Range("R3").Text

For Each rngZelle In Worksheets("Visuell").[zielbereich]
dteTermindatum = DateValue(1 & ". " & Cells(50, rngZelle.Column) & " " & Cells(49, rngZelle.Column))
If dteTermindatum >= dteStartdatum And dteTermindatum
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

HilfeProblem · 22. Februar 2013

Hallo
und
vielen Dank für deine schnelle Hilfe =)
Da wäre ich nie drauf gekommen.
Funktioniert super.

Das wäre echt super, wenn das mit den Zahlen als Farbe noch klappen würde.
Echt toll, dankeschön =)

Gruß

Hasso · 22. Februar 2013

Hallo HilfeProblem,

Das wäre echt super, wenn das mit den Zahlen als Farbe noch klappen würde.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Es hat geklappt. Einfach im Code die roten Stellen ändern: Code:

Private Sub CommandButton1_Click()

Dim rngZelle As Range
Dim dteStartdatum As Date
Dim dteEnddatum As Date
Dim dteTermindatum As Date
Dim Farbe
Dim intRot As Integer
Dim intGruen As Integer
Dim intBlau As String
Dim intSpalte As Integer

Worksheets("Visuell").Range("C51:DF90").Name = "Zielbereich"
Worksheets("Farbcodes").Range("A2:D57").Name = "farbtabelle"
dteStartdatum = DateValue(1 & "." & Left(Range("C3"), 3) & " " & Right(Range("C3"), 2))
dteEnddatum = DateValue(1 & "." & Left(Range("F3"), 3) & " " & Right(Range("F3"), 2))
Farbe = Worksheets("Visuell").Range("R3")

intRot = Application.WorksheetFunction.VLookup(Farbe, [farbtabelle], 2, False)
intGruen = Application.WorksheetFunction.VLookup(Farbe, [farbtabelle], 3, False)
intBlau = Application.WorksheetFunction.VLookup(Farbe, [farbtabelle], 4, False)

For Each rngZelle In Worksheets("Visuell").[zielbereich]
dteTermindatum = DateValue(1 & ". " & Cells(50, rngZelle.Column) & " " & Cells(49, rngZelle.Column))
If dteTermindatum >= dteStartdatum And dteTermindatum
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

HilfeProblem · 26. Februar 2013

Hallo =)

Vielen Dank für deine schnelle Hilfe.
Hat alles super funktioniert.
Danke dafür.
Hätte ich niemals alleine hinbekommen.
Habe die Formel noch etwas geändert, jetzt macht sie genau das was ich brauche.

Jetzt muss ich allerdings noch eine Raute in Abhängigkeit des eingetragenen Monats einbringen.

Ich habe wieder eine Beispieldatei erstellt und reingeschrieben was ich genau meine ;-) Sonst ist das glaub ich wieder schwer verständlich.

Es wäre super wenn du dafür auch eine Lösung hast.
Habe bisher viel gegoogelt aber nichts passendes gefunden.

Vielen Dank schonmal für deine bisherige Hilfe

Grüße

Hasso · 26. Februar 2013

Deinem Wunsch kann gerne entsprochen werden: Code:

Private Sub Test_Raute_Click()
Dim lngLinks As Long
Dim lngTop As Long
Dim intJahr As Integer
Dim strMonat As String
Dim rngZelle As Range
Dim intSpalte As Integer
Dim shpRaute As Shape

intJahr = Val(Right(ActiveSheet.Range("C3"), 2)) + 2000
strMonat = Left(ActiveSheet.Range("C3"), 3)
For Each rngZelle In ActiveSheet.Range("C48:CU48")
If rngZelle = intJahr Then
Select Case strMonat
Case "Jan"
intSpalte = rngZelle.Column
Case "Feb"
intSpalte = rngZelle.Column + 1
Case "Mrz"
intSpalte = rngZelle.Column + 2
Case "Apr"
intSpalte = rngZelle.Column + 3
Case "Mai"
intSpalte = rngZelle.Column + 4
Case "Jun"
intSpalte = rngZelle.Column + 5
Case "Jul"
intSpalte = rngZelle.Column + 6
Case "Aug"
intSpalte = rngZelle.Column + 7
Case "Sep"
intSpalte = rngZelle.Column + 8
Case "Okt"
intSpalte = rngZelle.Column + 9
Case "Nov"
intSpalte = rngZelle.Column + 10
Case "Dez"
intSpalte = rngZelle.Column + 11
End Select
Exit For
End If
Next rngZelle
'----------------------------------------------
' alte Rauten löschen:
'----------------------------------------------
For Each shpRaute In ActiveSheet.Shapes
If shpRaute.Top = Cells(51, 1).Top Then shpRaute.Delete
Next shpRaute

ActiveSheet.Shapes.AddShape(msoShapeDiamond, Worksheets("Visuell").Cells(51, intSpalte).Left, Worksheets("Visuell").Cells(51, intSpalte).Top, 20, 30).Select
'Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
With Selection.ShapeRange
With .Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(200, 0, 0)
.Transparency = 0
.Solid
End With
.Line.Visible = msoFalse
End With
Range("G16").Select

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

Beispielmappe anbei.

HilfeProblem · 28. Februar 2013

Hallo,

hat super funktioniert.

VielenVielen Dank nochmal dafür =)

Office: Meherer Zellen mit VBA farbig markieren

Meherer Zellen mit VBA farbig markieren

Meherer Zellen mit VBA farbig markieren

Meherer Zellen mit VBA farbig markieren

Meherer Zellen mit VBA farbig markieren

Meherer Zellen mit VBA farbig markieren - Similar Threads - Meherer Zellen VBA

Aus meheren Tabellen eine Gesamttabelle mit Datum erstellen

Mitglied mit meheren Funktionen

Wenn Funktion über mehere Zellen

Nach Allen Werten aus meheren Zeilen suchen und Auflisten, welche in einem Zeitraum

Tabelle aus meheren Excel-Dateien zusammenführen

Pivot Tabellen - Filter für mehere Pivottabellen gleichzeitig setzten.

Dienstplan, eine Eingabe dann mehere Ausgaben. VBA