Makro - für Formatierung | HERBERS Excel Forum

Hallo,
ich suche einen Code für folgendes Problem:
1.) suche in den Bereichen D5:D35 und G5:G35 und J5:J35 das heutige Datum (wenn das heutige Datum vorhanden ist, kann es nur 1mal vorkommen)
2.) stelle die Hintergrundfarbe der gefundenen Zelle auf Rot und die Schriftfarbe auf Weiß
3.) formatiere ausgehend von der gefundenen Zelle die 2 linken Nachbarzellen ebenso wie oben angeführt
Beispiel:
heutiges Datum steht in G30
dann Format für G30 und F30 und E30 mit Hintergrundfarbe Rot und Schriftfarbe Weiß einstellen.
Hinweis: die 3 Möglichkeiten der bedingten Formatierung habe ich bereits ausgeschöpft und das will ich auch so belassen. Ist trotzdem noch eine Formatierung über VBA wie oben angeführt möglich? Wenn ja, wie?
Servus, Walter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro - für Formatierung

02.12.2007 10:57:12

Uduuh

AW: Makro - für Formatierung

02.12.2007 11:01:46

WalterK

VBA Beispiel

02.12.2007 11:43:55

Matthias

AW: VBA Beispiel

02.12.2007 12:52:00

WalterK

AW: VBA Beispiel

02.12.2007 13:19:00

Gerd

AW: VBA Beispiel

02.12.2007 14:22:11

Matthias

AW: zu 2. offen

02.12.2007 15:34:20

WalterK

deshalb doch zu 2.) = noch offen ...

02.12.2007 20:12:00

Matthias

AW: zu 2. offen

02.12.2007 20:34:00

Josef

AW: VBA Beispiel

02.12.2007 20:20:00

Daniel

AW: Halt!!

02.12.2007 21:06:15

WalterK

Private Sub Workbook_Open() 'Ins Modul DieseArbeitsmappe Dim rngU As Range, rngGef As Range, rngZelle As Range, Ws As Worksheet Set Ws = Worksheets("Tabelle1") Set rngU = Union(Ws.Range("D5:D35"), Ws.Range("G5:G35"), Ws.Range("J5:J35")) 'Innenfarbe u. Schriftfarbe ggf. zurücksetzen For Each rngZelle In rngU If rngZelle.Font.ColorIndex = 2 Then rngZelle.Offset(0, -2).Resize(, 3).Font.ColorIndex = 1 If rngZelle.Interior.Color = vbRed Then rngZelle.Offset(0, -2).Resize(, 3).Interior. _ ColorIndex = xlNone: Exit For Next Set rngGef = rngU.Find(Date, LookIn:=xlFormulas, lookat:=xlWhole) If Not rngGef Is Nothing Then rngGef.Offset(0, -2).Resize(, 3).Font.ColorIndex = 2 rngGef.Offset(0, -2).Resize(, 3).Interior.Color = vbRed End If End Sub

Hallo Walter,
schmeis doch die Bedingte Formatierung raus und erledige alles per Code.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_Open()
Tabelle1.setColor
End Sub

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("input")) Is Nothing Or _
    Not Intersect(Target, Me.Range("bereich")) Is Nothing Then

    setColor
End If
End Sub

Sub setColor()
Dim rng As Range

For Each rng In Range("input")
    If rng.Offset(0, 1) = Date Then
        With Range(Cells(rng.Row, rng.Column - 1), Cells(rng.Row, rng.Column + 1))
            .Interior.ColorIndex = 3
            .Font.ColorIndex = 2
        End With
    Else
        With Range(Cells(rng.Row, rng.Column - 1), Cells(rng.Row, rng.Column + 1))
            .Interior.ColorIndex = xlNone
            .Font.ColorIndex = xlAutomatic
        End With
        Select Case rng.Text
            Case "x"
                rng.Offset(0, 1).Interior.ColorIndex = 34
            Case "y"
                rng.Offset(0, 1).Interior.ColorIndex = 8
            Case "z"
                rng.Offset(0, 1).Interior.ColorIndex = 33
        End Select
    End If
Next

End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Makro - für Formatierung

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread