Markierte Zellen

Question

Hallo,

ich verwende nachfolgendes Makro zum Prüfen, ob sich eine markierte Zelle in eine bestimmten Bereich befindet. Dies funktioniert nur mit der aktiven Zelle. Kann man das Makro erweitern bzw. neues Makro, dass alle markierten Zellen geprüft werden?

Sub ImBereich()

Dim Zielbereich As Range
Set Zielbereich = Sheets("Tabelle1").Range("A1:D10")

If Intersect(ActiveCell, Zielbereich) Is Nothing Then
MsgBox "Die aktive Zelle liegt nicht im definierten Zielbereich!"
Else
MsgBox "Die Zelle liegt im definierten Zielbereich"
End If


End Sub


Ciao Camillo

Answer 1

Hallo Camillo,

Du kennst Dich ja mit VBA aus.
[code]
Private Sub Worksheet_Change(ByVal Target As Range)
'***********************************************
'* H. Ziplies *
'* 07.11.12 *
'* erstellt von HajoZiplies@web.de *
'* http://Hajo-Excel.de/ *
'***********************************************
' Füllfarbe
' für Schrift RaZelle.Font.ColorIndex
Dim RaBereich As Range ' Variable für Bereich
Dim RaZelle As Range ' Variable für Zelle
Set RaBereich = Range("L22:M39, O21:O26") ' Bereich der Wirksamkeit
' noch mehr Bereiche
'Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17"), _
' Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49"), _
' Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81"), _
' Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111"), _
' Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139"), _
' Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163"), _
' Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191"))
' ab Vesion XP braucht der Schutz nicht aufgehoben werden
' Formatierung bei Schutz kann über Dialog Schutz eingestellt werden
' Zelle die in dem Bereich liegen auf die Variable schreiben
' damit werden nur noch die Zellen bearbeitet die im vorgegeben Bereich liegen
' jede Zelladresse ist einzeln angegeben
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then
'ActiveSheet.Unprotect ("Passwort")
For Each RaZelle In RaBereich
With RaZelle
Select Case UCase(.Value) ' Umwandlung der Eingabe in Großbuchstaben
Case "1"
.Interior.Color = 0 ' Füllfarbe Schwarz
.Font.Color = 16777215 ' Schriffarbbe weiß
.NumberFormat = "General" ' Zellenformat Standard
Case "2"
.Interior.Color = 65535 ' Füllfarbe Gelb
' Schriffarbe automatisch
.Font.ColorIndex = xlAutomatic
.NumberFormat = "General"
Case "3"
.Interior.Color = 255 ' Füllfarbe Rot
.NumberFormat = ";;;" ' Zellformat nicht sichtbar
Case "4"
.Interior.Color = 65280 ' Füllfarbe Grün
.Font.ColorIndex = xlAutomatic
.NumberFormat = "General"
Case "KLAUS"
.Interior.Color = 16711680 ' Füllfarbe blau
.Font.Color = 12632256 ' Schriftfarbe Grau - 25%
.NumberFormat = "General"
Case Else
' keine Füllfarbe, ColorIndex nicht Color
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
.NumberFormat = "General"
End Select
End With
Next RaZelle
'ActiveSheet.protect ("Passwort")
End If
Set RaBereich = Nothing ' Variable leeren
End Sub
[quote]

Gruß Hajo

Answer 2

Hallo Hajo,
vielen Dank für dein Makro. Leider ist es nicht das, was ich mir vorstelle.

Ich möchte folgende Funktion.

Im Bereich A1 - A100 werden z.B. die Zellen A2, A4, A54, A81 markiert. Beim Start des Makros soll nun die Meldung erscheinen "Die aktiven Zellen liegen im definierten Zielbereich".

Wenn nun versehentlich jedoch die Zellen A2, B4, A57, A88 markiert wurden, soll die Meldung "Zellen nicht im definierten Zielbereich" erscheinen.

Es dürfen nur Zellen im Bereich A1 - A100 markiert sein.

Die Angabe bei den Zellen sind nur Beispiele.

Ciao Camillo

Answer 3

Hallo Camillo,
vielleicht hilft Dir das Makro weiter:

Sub ImBereich()
Dim Zelle As Range
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Sheets("Tabelle1").Range("A1:D10")
Application.EnableEvents = False
For Each RaZelle In Selection
If Not Intersect(RaZelle, RaBereich) Is Nothing Then MsgBox "Die Zelle" + " " & Selection.Address + " " + "liegt im definierten Zielbereich"
If Intersect(RaZelle, RaBereich) Is Nothing Then MsgBox "Die Zelle" + " " & Selection.Address + " " + "liegt nicht im definierten Zielbereich"
Next RaZelle
Application.EnableEvents = True
Set RaBereich = Nothing
End Sub

Gruß
fedjo

Answer 4

Hallo fedjo,

danke für dein Makro. Es läuft super.

Camillo