Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
304to308
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
304to308
304to308
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

offene Zellen MARKIEREN - Auswahlbereich

offene Zellen MARKIEREN - Auswahlbereich
05.09.2003 13:40:55
Tanja
Hallo Profis, (und Hallo WernerB),

beziehe mich auf folgenden thread - der eigentlich ja schon abgeschlossen ist:

https://www.herber.de/forum/archiv/304to308/t304622.htm

Hier folgt der prima funktionierende Code daraus:


Sub OffeneZellenFaerbenblau()
Dim RaZelle As Range
Dim Bereich As Range
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 !" _
, 0, "Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
On Error GoTo 0
'ActiveSheet.Unprotect
Application.ScreenUpdating = False
For Each RaZelle In Bereich
If RaZelle.Locked = False Then RaZelle.Interior.ColorIndex = 5
' zurück
' If RaZelle.Locked = True Then RaZelle.Interior.ColorIndex = xlNone
Next RaZelle
Set Bereich = Nothing
Application.ScreenUpdating = True
End Sub




Dazu habe ich noch eine "I-Tüpfelchen"-Frage :o)
Wäre es denn möglich die Zellen im Auswahlbereich nicht zu färben, sondern lediglich zusammenhängend zu markieren? ...man könnte vielleicht auch die Größe des Auswahlbereiches beschränken, falls das ein Problem wäre, oder?

Ich glaube, eine ähnliche Frage habe ich schon mal hier eingekippt, konnte aber den thread per Recherche nicht finden - damals ist meines Wissens keine zufriedenstellende Lösung zu Stande gekommen :o(

Hat jemand eine Idee?

Vielen Dank im Voraus!
Gruß
Tanja

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: offene Zellen MARKIEREN - Auswahlbereich
05.09.2003 14:49:02
Martin Beck
Hallo Tanja,

versuche mal


Sub OffeneZellenFaerbenblau()
Dim RaZelle As Range
Dim Bereich As Range
Dim ErgBereich As Range
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 !" _
, 0, "Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
On Error GoTo 0
Application.ScreenUpdating = False
For Each RaZelle In Bereich
If RaZelle.Locked = False Then
Set ErgBereich = RaZelle
MsgBox ErgBereich.Address
Exit For
End If
Next RaZelle
For Each RaZelle In Bereich
If RaZelle.Locked = False Then
Set ErgBereich = Application.Union(ErgBereich, RaZelle)
End If
Next RaZelle
ErgBereich.Select
Set ErgBereich = Nothing
Set Bereich = Nothing
Application.ScreenUpdating = True
End Sub


Gruß
Martin Beck
Anzeige
AW: cool! offene Zellen MARKIEREN - Auswahlbereich
05.09.2003 15:03:54
Tanja
Hallo Martin,

ich hab's gerade nur ganz kurz getestet - scheint einwandfrei zu funktionieren!!

Einzig - am Ende des Vorgangs wird noch ein einziger Zellenname des nun markierten Bereiches (als Messagebox o. ä.) ausgeworfen! Stört zwar nicht weiter, aber war das Absicht? :o)

VIELEN DANK!

Gruß
Tanja
AW: cool! offene Zellen MARKIEREN - Auswahlbereich
06.09.2003 18:19:53
Martin Beck
Hallo Tanja,

die Zeile

MsgBox ErgBereich.Address

kannst Du löshen, die war nur zum testen gedacht.

Gruß
Martin Beck
AW: offene Zellen MARKIEREN - Auswahlbereich
05.09.2003 15:35:01
WernerB.
Hallo Tanja,

m.W. gibt es für die Anzahl der zu selektierenden Zellen wohl eine Obergrenze - aber wo die liegt, weiß ich leider auch nicht.
Du solltest Dich eben vorsichtig an diese Grenze herantasten.

Sub OffeneZellenSelektieren()
Dim RaZelle As Range
Dim Bereich As Range
Dim zS As String
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 + v, "Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
On Error GoTo 0
Application.ScreenUpdating = False
For Each RaZelle In Bereich
If RaZelle.Locked = False Then zS = zS & RaZelle.Address(False, False) & ", "
Next RaZelle
Set Bereich = Nothing
If zS <> "" Then
zS = Left(zS, Len(zS) - 2)
Range(zS).Select
Else
MsgBox "Nichts gefunden !", vbOKOnly + vbExclamation, _
"Dezenter Hinweis für " & Application.UserName & ":"
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 dazu Forums-FAQ)!
Anzeige
Korrektur
06.09.2003 10:16:58
WernerB.
Hallo Tanja,

das Makro in meinem vorigen Beitrag ist fehlerhaft. Bei der Erstellung wurde ich leider mehrfach gestört und war von daher wohl etwas unkonzentriert.
Die Lösung von Martin (Union-Methode) ist aber sowieso die eindeutig bessere, zumal sie auch viel sicherer ist; meine Lösung hingegen kann u.U. zu einem Excel-Absturz führen.

Die Anzeige einer Zelladresse in Martins Programm ist bestmmt nur ein jetzt überflüssiges Überbleibsel aus der Testphase. Allerdings läuft sein Programm auf einen Fehler, wenn ein Bereich erfolglos durchsucht wird, also keine ungesperrten Zellen beinhaltet.

Deshalb habe ich im nachstehenden Programm Martins Union-Methode übernommen und diesen Fehler noch abgefangen:

Sub UngesperrteZellenSelektieren()
Dim c As Range
Dim Bereich As Range
Dim ErgBereich As Range
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
For Each c In Bereich
If c.Locked = False Then
Set ErgBereich = c
Exit For
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 c.Locked = False Then
Set ErgBereich = Application.Union(ErgBereich, c)
End If
Next c
ErgBereich.Select
Set ErgBereich = Nothing
Set Bereich = Nothing
End If
Application.ScreenUpdating = True
End Sub

Gruß WernerB.
Anzeige
AW: Klasse! - Vielen Dank
08.09.2003 07:40:36
Tanja
Hallo WernerB, Hallo Martin Beck,

ihr seid wirklich klasse! - das ganze ist nun wirklich sowas von benutzerfreundlich...
Herzlichen Dank für eure Hilfe :o))))

Gruß und einen guten Start in die Woche!
Tanja

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige