AW: Nur farbige/nicht farbige Zellen markieren
06.10.2003 09:55:50
WernerB.
Hallo Dennis,
was hältst Du hiervon?
Option Explicit
Sub Dennis()
Dim c As Range, Bereich As Range, ErgBereich As Range
Dim Ant As Byte
On Error Resume Next
Set Bereich = Application.InputBox("Bitte Bereich mit der Maus markieren", _
"Bereichswahl", , , , , , 8)
If Bereich Is Nothing Then
MsgBox "Nichts selektiert !" & vbCr & vbCr & "Makro-Abbruch !", _
vbOKOnly + vbCritical, "Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
On Error GoTo 0
Application.ScreenUpdating = False
Ant = MsgBox("Nur farbige Zellen markieren ?", vbYesNo + vbQuestion, _
"Frage an " & Application.UserName & ":")
For Each c In Bereich
If Ant = 6 Then
If c.Interior.ColorIndex <> xlNone Then
Set ErgBereich = c
Exit For
End If
Else
If c.Interior.ColorIndex = xlNone Then
Set ErgBereich = c
Exit For
End If
End If
Next c
If ErgBereich Is Nothing Then
MsgBox "Nichts gefunden !", vbOKOnly + vbInformation, _
"Dezenter Hinweis für " & Application.UserName & ":"
Else
For Each c In Bereich
If Ant = 6 Then
If c.Interior.ColorIndex <> xlNone Then
Set ErgBereich = Application.Union(ErgBereich, c)
End If
Else
If c.Interior.ColorIndex = xlNone Then
Set ErgBereich = Application.Union(ErgBereich, c)
End If
End If
Next c
ErgBereich.Select
Set ErgBereich = Nothing
Set Bereich = Nothing
End If
Application.ScreenUpdating = True
End Sub
Viel Erfolg wünscht
WernerB.
P.S.: Das Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter (siehe Forums-FAQ).