Bereiche "subtrahieren"

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim rng As Range Set rng = [F5:Z3000] For i = 10 To Target.Row Step 10 If Target.Row = i Then Exit Sub Next i If (Intersect(Target, rng) Is Nothing) Then Exit Sub Intersect(Target, rng).Interior.ColorIndex = 33 End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) On Error Resume Next Dim rng As Range, lRow As Long Set rng = [F5:Z3000] If Target.Cells.Count > 10000 Then MsgBox "Bitte nicht so große Bereiche markieren", , "Gebe bekannt..." Exit Sub End If For lRow = Target.Row To Target.Rows.Count If (lRow + 5) Mod 10 <> 0 Then Intersect(Rows(lRow), rng).Interior.ColorIndex = 3 Else Intersect(Rows(lRow), rng).Interior.ColorIndex = xlNone End If Next lRow End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) On Error Resume Next Dim rng As Range, lRow As Long Set rng = [F5:Z3000] If Target.Cells.Count > 10000 Then MsgBox "Bitte nicht so große Bereiche markieren", , "Gebe bekannt..." Exit Sub End If For lRow = Target.Row To Target.Row + Target.Rows.Count If (lRow + 5) Mod 10 <> 0 Then Intersect(Intersect(Rows(lRow), Target), rng).Interior.ColorIndex = 3 Else Intersect(Intersect(Rows(lRow), Target), rng).Interior.ColorIndex = xlNone End If Next lRow End Sub

Hi Galenzo,
nachfolgende Makros funktionieren.
Allerdings traten 2 Dinge auf, von denen ich nur eins glattgebügelt habe.

1) Wenn exakt eine Zelle markiert wird, so werden in 10 Zellen Formate reinkopiert, deshalb ist im Code die Abfrage:
If Bereich.Cells.Count <> 1 Then

2) Noch nicht korrigiert ist das Phänomen, dass, wenn mehrere Zellen im Grenzbereich von F5:Z3000 markiert werden und davon liegt exakt eine im Bereich F5:Z3000 dann werden auch die Zellen außerhalb des Bereichs F5:Z3000 mit formatiert.
Müßtest du ggfs noch abfangen.

Gruß
Reinhard

Sub NurEinmalNötig()
Set WS3 = ThisWorkbook.Worksheets("Tabelle3")
Set WS1 = ThisWorkbook.Worksheets("Tabelle1")
WS3.Range("A1:A9").Interior.ColorIndex = 33
WS3.Range("A10").Interior.ColorIndex = xlNone
WS1.Activate
Set WS3 = Nothing
Set WS1 = Nothing
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Bereich = Application.Intersect(Target, Worksheets("Tabelle1").Range("F5:Z3000"))
If Bereich Is Nothing Then Exit Sub
If Bereich.Cells.Count <> 1 Then
ThisWorkbook.Worksheets("Tabelle3").Range("A1:A10").Copy
Bereich.PasteSpecial Paste:=xlFormats
Else
Target.Interior.ColorIndex = 33
End If
Set Bereich = Nothing
End Sub

Sub test()
ActiveSheet.Cells.Interior.ColorIndex = xlNone
End Sub

Danke Reinhard.

Das trifft's leider nicht ganz.
Ich habe mich in meiner Fragestellung vielleicht etwas ungenau ausgedrückt.

In meinem Worksheet_SelectionChange mache ich das:

Dim rng As Range
Set rng = [F5:Z3000]
Intersect(Target, rng).Interior.ColorIndex = 33

Ergebnis: ALLE Zellen meiner Auswahl, die IN dem Bereich rng liegen werden gefärbt.
Ich möchte aber, daß die Zeilen 10, 20, 30 usw. NICHT mit umgefärbt werden.
Ich dachte daran, dies gleich bei der Definition des "Prüf"-Bereiches rng zu berücksichtigen. Ich könnte ja schreiben:
set rng=([F5:Z9],[F11:Z19],[F21:Z24]..... usw.
Das würde es ja dann so tun. Problem: Tabelle nach unten offen.

Ich werde nun aber den umgekehrten Weg gehen: Erst färben, dann den Bereich durchlaufen und aus den 10er-Zeilen wieder die Farbe rausnehmen.

Danke - und ein Frohes Fest.

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bereiche "subtrahieren"

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread