Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
316to320
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
316to320
316to320
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Nur farbige/nicht farbige Zellen markieren

Nur farbige/nicht farbige Zellen markieren
06.10.2003 09:26:04
Dennis
Guten Morgen!
Wie kann ich es anstellen, dass ich nach Wunsch entweder alle Zellen mit Hintergrundfarbe oder alle Zellen ohne Hintergrundfarbe markiert bekomme? Dies brauche ich um diverse Hintergrundfarben für mein Tabellenblatt auszuprobieren ohne per Hand mit Ctrl-Taste 5000 Zellen zu markieren!
Danke im voraus...

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
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).
Anzeige
Super-Genial!
06.10.2003 10:00:48
Dennis
Hallo Werner,
vielen Dank für Deine Mühe. Deine Lösung trifft den Nagel auf den Kopf! Habe mal alle Zellen eines Sheets markiert, dauert dann zwar ganz schön lange, aber es funktioniert.
Gruß
Dennis

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige