Bedingte Formatierung mit VBA-Modul

Sub BedingteFormatierung() Dim Z1, Z2, Z3, Z4, Z5 As Integer Dim F1, F2, F3, F4, F5 As String Z1 = 50 'grün F1 = 4 Z2 = 40 'gelb F2 = 6 Z3 = 25 'rot F3 = 3 Z4 = 15 'blau F4 = 5 Z5 = 0 'grau F5 = 15 Columns("A:B").Select 'Alte Farben entf. Selection.Interior.ColorIndex = xlNone 'Spalte A [A2].Select 'Neue Markierungen setzen Do Until IsEmpty(ActiveCell.Value) If ActiveCell.Value = Z1 Then ActiveCell.Interior.ColorIndex = F1 ActiveCell.Offset(1, 0).Select ElseIf ActiveCell.Value = Z2 Then ActiveCell.Interior.ColorIndex = F2 ActiveCell.Offset(1, 0).Select ElseIf ActiveCell.Value = Z3 Then ActiveCell.Interior.ColorIndex = F3 ActiveCell.Offset(1, 0).Select ElseIf ActiveCell.Value = Z4 Then ActiveCell.Interior.ColorIndex = F4 ActiveCell.Offset(1, 0).Select ElseIf ActiveCell.Value = Z5 Then ActiveCell.Interior.ColorIndex = F5 ActiveCell.Offset(1, 0).Select Else ActiveCell.Offset(1, 0).Select End If Loop 'Spalte B [B2].Select 'Neue Markierungen setzen Do Until IsEmpty(ActiveCell.Value) If ActiveCell.Value = Z1 Then ActiveCell.Interior.ColorIndex = F1 ActiveCell.Offset(1, 0).Select ElseIf ActiveCell.Value = Z2 Then ActiveCell.Interior.ColorIndex = F2 ActiveCell.Offset(1, 0).Select ElseIf ActiveCell.Value = Z3 Then ActiveCell.Interior.ColorIndex = F3 ActiveCell.Offset(1, 0).Select ElseIf ActiveCell.Value = Z4 Then ActiveCell.Interior.ColorIndex = F4 ActiveCell.Offset(1, 0).Select ElseIf ActiveCell.Value = Z5 Then ActiveCell.Interior.ColorIndex = F5 ActiveCell.Offset(1, 0).Select Else ActiveCell.Offset(1, 0).Select End If Loop 'Spalte C usw. [A1].Select End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Stefan,
probiere es mal so:

VBA-Code:

Sub BedingteFormatierung()
Dim Zelle As Range
Dim Zeile As Long
Dim Spalte As Integer
Dim Z1, Z2, Z3, Z4, Z5 As Integer
Dim F1, F2, F3, F4, F5 As String
Z1 = 50 'grün
F1 = 4
Z2 = 40 'gelb
F2 = 6
Z3 = 25 'rot
F3 = 3
Z4 = 15 'blau
F4 = 5
Z5 = 0 'grau
F5 = 15
Zeile = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Spalte = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
Cells.Interior.ColorIndex = xlNone
For Each Zelle In Range(Cells(2, "A"), Cells(Zeile, Spalte))
  If Zelle <> "" Then
    With Zelle
      Select Case Zelle
        Case Z1
          .Interior.ColorIndex = F1
        Case Z2
          .Interior.ColorIndex = F2
        Case Z3
        .Interior.ColorIndex = F3
        Case Z4
          .Interior.ColorIndex = F4
        Case Z5
        .Interior.ColorIndex = F5
        Case Else
          .Interior.ColorIndex = xlNone
      End Select
    End With
  End If
Next
End Sub
Gruß Jürgen

AW: Bedingte Formatierung mit VBA-Modul

Daniel

HI
der Code ist sowieso viel zu umständlich.
so könnte das schneller gehen:


Sub BedingteFormatierung()
Dim Z1, Z2, Z3, Z4, Z5 As Integer
Dim F1, F2, F3, F4, F5 As Integer
dim Zelle as range
Z1 = 50 'grün
F1 = 4
Z2 = 40 'gelb
F2 = 6
Z3 = 25 'rot
F3 = 3
Z4 = 15 'blau
F4 = 5
Z5 = 0 'grau
F5 = 15
Columns("A:B").Interior.ColorIndex = xlNone 'Alte Farben entf.
for each Zelle in Intersect(Range("A:B"), activesheet.usedrange)
select case Zelle.Value
case Z1
Zelle.Interior.ColorIndex = F1
case Z2
Zelle.Interior.ColorIndex = F2
case Z3
Zelle.Interior.ColorIndex = F3
case Z4
Zelle.Interior.ColorIndex = F4
case Z5
Zelle.Interior.ColorIndex = F5
Case else
End select
end sub

gruß, Daniel

AW: Bedingte Formatierung mit VBA-Modul

hary

Hallo Stafan
meinst Du so was. Bereich noch anpassen.
https://www.herber.de/bbs/user/58593.xls
Gruss hary

AW: Bedingte Formatierung mit VBA-Modul

Josef

Hallo Namenloser,
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub BedingteFormatierung()
    Dim Z1, Z2, Z3, Z4, Z5 As Integer
    Dim F1, F2, F3, F4, F5 As Integer
    Dim rngAll As Range, rngCells As Range, rng As Range

    Z1 = 50 'grün
    F1 = 4
    Z2 = 40 'gelb
    F2 = 6
    Z3 = 25 'rot
    F3 = 3
    Z4 = 15 'blau
    F4 = 5
    Z5 = 0 'grau
    F5 = 15

    Set rngAll = Columns("A:B") 'Spalten hier angeben!

    rngAll.Interior.ColorIndex = xlNone

    On Error Resume Next
    Set rngCells = rngAll.SpecialCells(xlCellTypeConstants, 1)
    On Error GoTo 0

    If Not rngCells Is Nothing Then
        For Each rng In rngCells
            Select Case rng.Value
                Case Z1
                    rng.Interior.ColorIndex = F1
                Case Z2
                    rng.Interior.ColorIndex = F2
                Case Z3
                    rng.Interior.ColorIndex = F3
                Case Z4
                    rng.Interior.ColorIndex = F4
                Case Z5
                    rng.Interior.ColorIndex = F5
                Case Else
            End Select
        Next
    End If

    Set rngAll = Nothing
    Set rngCells = Nothing
    Set rng = Nothing
End Sub

Gruß Sepp

AW: Bedingte Formatierung mit VBA-Modul

Stefan

Hallo zusammen
Vielen Dank für eure Beispiele. Ich hätte nicht gedacht, dass ich so schnell auf eure Unterstützung zählen kann. Genau so wie in euren Beispielen habe ich's mir vorgestellt. Dank euch kann ich nun mein Projekt fortsetzen.
Gruss
Stefan

Sub BedingteFormatierung() Dim Z1, Z2, Z3, Z4, Z5 As Integer Dim F1, F2, F3, F4, F5 As Integer dim Zelle as range Z1 = 50 'grün F1 = 4 Z2 = 40 'gelb F2 = 6 Z3 = 25 'rot F3 = 3 Z4 = 15 'blau F4 = 5 Z5 = 0 'grau F5 = 15 Columns("A:B").Interior.ColorIndex = xlNone 'Alte Farben entf. for each Zelle in Intersect(Range("A:B"), activesheet.usedrange) select case Zelle.Value case Z1 Zelle.Interior.ColorIndex = F1 case Z2 Zelle.Interior.ColorIndex = F2 case Z3 Zelle.Interior.ColorIndex = F3 case Z4 Zelle.Interior.ColorIndex = F4 case Z5 Zelle.Interior.ColorIndex = F5 Case else End select end sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Bedingte Formatierung mit VBA-Modul

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

328 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bedingte Formatierung mit VBA-Modul

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

328 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread