Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Suchen nach farbig unterlegten Zellen

Betrifft: Suchen nach farbig unterlegten Zellen von: Stephan
Geschrieben am: 18.08.2004 20:28:32

Liebe Forumsmitglieder,

in den Zellen A4:Z3000 wurden durch die bedingte Formatierung bestimmte Zellen farbig unterlegt. Nun ist das Scrollen auf Grund der Vielzahl der Zellen ziemlich nervig ;-(

Gibt es evtl. einen Code, der automatisch zur nächsten farbig unterlegten Zelle springt ?

Wäre toll ...

Viele Grüße

Stephan

  


Betrifft: AW: Suchen nach farbig unterlegten Zellen von: Udo
Geschrieben am: 18.08.2004 22:12:02

Auslesen bedingter Formate ist sehr aufwändig und wird deshelb kaum angewendet.

Udo


  


Betrifft: AW: Suchen nach farbig unterlegten Zellen von: nighty
Geschrieben am: 19.08.2004 14:06:02

hi stephan :)

wie gewuenscht :)

gruss nighty

Public zeile As Long
Public spalte As Integer
Sub makro01()
Rem zeile = 0
Rem spalte = 0
Dim zaehler1 As Integer
Dim zaehler2 As Long
Dim zaehler3 As Integer
Dim suche1 As Range
Dim zaehler4 As Boolean
zaehler0 = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
zaehler1 = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column + 1
For zaehler2 = 1 To zaehler0
For zaehler3 = 1 To zaehler1
test = GetCellColor(Cells(zaehler2, zaehler3))
If test = 3 And zeile < zaehler2 Or test = 3 And spalte < zaehler3 Then
Cells(zaehler2, zaehler3).Select
zeile = zaehler2
spalte = zaehler3
zaehler4 = True
Exit For
End If
Next zaehler3
If zaehler4 = True Then Exit For
Next zaehler2
If zaehler4 = False And zaehler3 = zaehler1 + 1 And zaehler2 = zaehler0 + 1 Then
zeile = 0
spalte = 0
Beenden = _
    MsgBox("Das ende wurde erreicht,es wird zum Anfang gesprungen" & Chr(13) _
    & "bei erneuten Start !", vbQuestion)
End If
End Sub

Function GetCellColor(cell As Range) As Integer
Dim i
Dim myVal
Dim myColor As Integer
Dim done As Boolean
On Error Resume Next
Names("testname").Delete
On Error GoTo 0
Application.ReferenceStyle = xlR1C1
myVal = cell.Value
myColor = cell.Interior.ColorIndex
done = False
For i = 1 To cell.FormatConditions.Count
With cell.FormatConditions.Item(i)
If .Type = 1 Then
Select Case .Operator
Case xlBetween
If (myVal >= Evaluate(.Formula1) And myVal <= Evaluate(.Formula2)) _
Or (myVal <= Evaluate(.Formula1) And myVal >= Evaluate(.Formula2)) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlEqual
If myVal = Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlGreater
If myVal > Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlGreaterEqual
If myVal >= Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlLess
If myVal < Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlLessEqual
If myVal <= Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlNotBetween
If myVal < Evaluate(.Formula1) Or myVal > Evaluate(.Formula2) Then
myColor = .Interior.ColorIndex
done = True
End If
Case xlNotEqual
If myVal <> Evaluate(.Formula1) Then
myColor = .Interior.ColorIndex
done = True
End If
End Select
ElseIf .Type = 2 Then
Names.Add Name:="testname", RefersToR1C1Local:=.Formula1
If Evaluate("testname") Then
myColor = .Interior.ColorIndex
done = True
End If
Names("testname").Delete
Else
MsgBox "Unbekannter Typ: " & .Type, , "PANIC: In 
Function GetCellColor"
Exit Function
End If
End With
If done Then Exit For
Next
Application.ReferenceStyle = xlA1
GetCellColor = myColor
End Function



  


Betrifft: AW: Suchen nach farbig unterlegten Zellen von: nighty
Geschrieben am: 19.08.2004 14:30:01

hi stephan :)

ups zur zeit noch auf rot eingestellt,die erste zeile gegen die zweite ersetzen

Sub makro01
rem diese
If test = 3 And zeile < zaehler2 Or test = 3 And spalte < zaehler3 Then
rem gegen diese ersetzen im obigen code
If test > -1 And zeile < zaehler2 Or test = 3 And spalte < zaehler3 Then
End Sub


jetzt werden alle farben einbezogen

gruss nighty


 

Beiträge aus den Excel-Beispielen zum Thema "Suchen nach farbig unterlegten Zellen "