Zelle färbenm wenn zwei Bedingungen

Sub Guthaben_größer_Null_färben() Dim zeile As Long Dim LetzteZeile As Long With ActiveSheet Range("K2").Select 'Spalte und Zelle anpassen LetzteZeile = .Range("A65536").End(xlUp).Row For zeile = 1 To LetzteZeile If ActiveCell.Value > "0,00 " Then ActiveCell.Select Selection.Interior.ColorIndex = 3 ActiveCell.Offset(1, 0).Select Else ActiveCell.Offset(1, 0).Select End If Next zeile End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Sandra,
das macht man normalerweise ohne VBA mit bedingter Formatierung, aber hier der Code
ohne Select und Activate, der Cursor ist doch kein Hund den man durch die Gegend hetzt;-))

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Guthaben_größer_Null_färben()
  Dim rngRed As Range, rng As Range
  Dim LetzteZeile As Long

  With ActiveSheet
    LetzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
    For Each rng In .Range(.Cells(1, 11), .Cells(LetzteZeile, 11))
      If rng.Value > 0 Then
        If rngRed Is Nothing Then
          Set rngRed = rng
        Else
          Set rngRed = Union(rngRed, rng)
        End If
      End If
      If rng.Offset(0, -10).Value = "a" Then
        If rngRed Is Nothing Then
          Set rngRed = rng.Offset(0, -10)
        Else
          Set rngRed = Union(rngRed, rng.Offset(0, -10))
        End If
      End If
    Next
  End With

  If Not rngRed Is Nothing Then rngRed.Interior.ColorIndex = 3

  Set rngRed = Nothing
  Set rng = Nothing
End Sub

Gruß Sepp

Hallo Sepp
Zitat:
Es soll jetzt noch auf die Spalte A geprüft werden, ob dort ein "a" vorhanden ist.
Wenn ja, dann soll die Zelle in der Spalte K rot gefärbt werden.
Du meintest also sicher so ?


Sub Guthaben_größer_Null_färben()
Dim rngRed As Range, rng As Range
Dim LetzteZeile As Long
With ActiveSheet
LetzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In .Range(.Cells(1, 11), .Cells(LetzteZeile, 11))
If rng.Value > 0 And rng.Offset(, -10).Value = "a" Then
If rngRed Is Nothing Then
Set rngRed = rng
Else
Set rngRed = Union(rngRed, rng)
End If
End If
Next
End With
If Not rngRed Is Nothing Then rngRed.Interior.ColorIndex = 3
Set rngRed = Nothing
Set rng = Nothing
End Sub

aber so würde es vielleicht auch schon reichen.


Sub sandra()
Dim LetzteZeile As Long, rng As Range
With ActiveSheet
LetzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In .Range(.Cells(1, 11), .Cells(LetzteZeile, 11))
If rng.Value > 0 And rng.Offset(, -10).Value = "a" Then rng.Interior.ColorIndex = 3
Next
End With
End Sub

Gruß Matthias

Beliebteste Forumthreads (12 Monate)

Zelle färbenm wenn zwei Bedingungen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Hallo Sandra

322 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zelle färbenm wenn zwei Bedingungen

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

Hallo Sandra

322 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread