Set Bereich = ActiveSheet.Range("C5:C12")
Public Sub BerMark()
Dim Bereich, Bereich1, Bereich2 As Range
Set Bereich = ActiveSheet.Range("C5:C12")
Set Bereich1 = ActiveSheet.Range("E5:E12")
Set Bereich2 = ActiveSheet.Range("G5:G12")
Union(Bereich, Bereich1, Bereich2).Activate
End Sub
Private Sub Worksheet_Change(ByVal Ziel As Excel.Range)
Dim Bereich1, Bereich2, Bereich3, Bereich4, Bereich5, Bereich6, Bereich7, Bereich8, _
Bereich9 As Range
Dim rngZelle As Range
Set Bereich1 = ActiveSheet.Range("C5:C12")
Set Bereich2 = ActiveSheet.Range("E5:E12")
Set Bereich3 = ActiveSheet.Range("H5:H12")
Set Bereich4 = ActiveSheet.Range("J5:J12")
Set Bereich5 = ActiveSheet.Range("L5:L12")
Set Bereich6 = ActiveSheet.Range("N5:N12")
Set Bereich7 = ActiveSheet.Range("P5:P12")
Set Bereich8 = ActiveSheet.Range("R5:R12")
Set Bereich9 = ActiveSheet.Range("U5:U12")
Set Bereich10 = ActiveSheet.Range("W5:W12")
Union(Bereich1, Bereich2, Bereich3, Bereich4, Bereich5, Bereich6, Bereich7, Bereich8, Bereich9). _
Activate
For Each rngZelle In Bereich
Select Case rngZelle.Value
Case Is = ""
rngZelle.Interior.Color = RGB(255, 255, 255)
Case Is = 0
rngZelle.Interior.Color = RGB(0, 255, 0)
Case Is = "Leihgerät"
rngZelle.Interior.Color = RGB(255, 255, 153)
Case Is Range("W2")
rngZelle.Interior.Color = RGB(255, 0, 0)
End Select
Next
End Sub
Sub sbMehrereBereiche()
Dim liSpalte As Integer, lloZeile As Long
For liSpalte = 3 To 7 Step 2
For lloZeile = 5 To 12
'hier dein Code, mit
'Cells(lloZeile, liSpalte).Value = ?
oder
'? = Cells(lloZeile, liSpalte).Value
'der ausgeführt werden soll
Next
Next
End Sub
Sub b()
Dim Bereich1, Bereich2, Bereich3, Bereich4, Bereich5, Bereich6, Bereich7, Bereich8, _
Bereich9, Bereich10 As Range
Dim rngZelle As Range
Dim Bereich As Range
Set Bereich1 = ActiveSheet.Range("C5:C12")
Set Bereich2 = ActiveSheet.Range("E5:E12")
Set Bereich3 = ActiveSheet.Range("H5:H12")
Set Bereich4 = ActiveSheet.Range("J5:J12")
Set Bereich5 = ActiveSheet.Range("L5:L12")
Set Bereich6 = ActiveSheet.Range("N5:N12")
Set Bereich7 = ActiveSheet.Range("P5:P12")
Set Bereich8 = ActiveSheet.Range("R5:R12")
Set Bereich9 = ActiveSheet.Range("U5:U12")
Set Bereich10 = ActiveSheet.Range("W5:W12")
Set Bereich = Union(Bereich1, Bereich2, Bereich3, Bereich4, Bereich5, Bereich6, Bereich7, _
Bereich8, Bereich9)
For Each rngZelle In Bereich
Select Case rngZelle.Value
Case Is = ""
rngZelle.Interior.Color = RGB(255, 255, 255)
Case Is = "0"
rngZelle.Interior.Color = RGB(0, 255, 0)
Case Is = "Leihgerät"
rngZelle.Interior.Color = RGB(255, 255, 153)
Case Is Range("W2")
rngZelle.Interior.Color = RGB(255, 0, 0)
End Select
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich, Zone(1 To 29), rngZelle As Range
Set Zone1 = ActiveSheet.Range("C5:C12")
Set Zone2 = ActiveSheet.Range("E5:E12")
Set Zone3 = ActiveSheet.Range("H5:H12")
Set Zone4 = ActiveSheet.Range("J5:J12")
Set Zone5 = ActiveSheet.Range("L5:L12")
Set Zone6 = ActiveSheet.Range("N5:N12")
Set Zone7 = ActiveSheet.Range("P5:P12")
Set Zone8 = ActiveSheet.Range("R5:R12")
Set Zone9 = ActiveSheet.Range("U5:U12")
Set Zone10 = ActiveSheet.Range("W5:W12")
Set Zone11 = ActiveSheet.Range("H17:H24")
Set Zone12 = ActiveSheet.Range("J17:J24")
Set Zone13 = ActiveSheet.Range("L17:L24")
Set Zone14 = ActiveSheet.Range("N17:N24")
Set Zone15 = ActiveSheet.Range("P17:P24")
Set Zone16 = ActiveSheet.Range("R17:R24")
Set Zone17 = ActiveSheet.Range("C30:C37")
Set Zone18 = ActiveSheet.Range("E30:E37")
Set Zone19 = ActiveSheet.Range("H30:H37")
Set Zone20 = ActiveSheet.Range("J30:J37")
Set Zone21 = ActiveSheet.Range("L30:L37")
Set Zone22 = ActiveSheet.Range("N30:N37")
Set Zone23 = ActiveSheet.Range("P30:P37")
Set Zone24 = ActiveSheet.Range("R30:R37")
Set Zone25 = ActiveSheet.Range("U30:U37")
Set Zone26 = ActiveSheet.Range("W30:W37")
Set Zone27 = ActiveSheet.Range("Z2:Z41")
Set Zone28 = ActiveSheet.Range("AB2:AB41")
Set Zone29 = ActiveSheet.Range("AD2:AD41")
Set Bereich = Application.Union(Zone1, Zone2, Zone3, Zone4, Zone5, Zone6, _
Zone7, Zone8, Zone9, Zone10, Zone11, Zone12, Zone13, Zone14, Zone15, Zone16, _
Zone17, Zone18, Zone19, Zone20, Zone21, Zone22, Zone23, Zone24, Zone25, Zone26, _
Zone27, Zone28, Zone29)
If Application.Intersect(Target, Bereich) Is Nothing Then Exit Sub
For Each rngZelle In Bereich
Select Case rngZelle.Value
Case Is = ""
rngZelle.Interior.ColorIndex = xlNone ' keine Füllung
Case Is = "Leihgerät"
rngZelle.Interior.ColorIndex = 6 ' gelb 6
Case Is = 0
rngZelle.Interior.ColorIndex = 10 ' grün
Case Is = 1
rngZelle.Interior.ColorIndex = 3 ' rot
End Select
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim rngZelle As Range
Set Bereich = ActiveSheet.Range("C5:C12,E5:E12,H5:H12,J5:J12,L5:L12,N5:N12,P5:P12,R5:R12,U5:U12, _
W5:W12")
For Each rngZelle In Bereich
Select Case rngZelle.Value
Case Is = ""
rngZelle.Interior.Color = RGB(255, 255, 255)
Case Is = "0"
rngZelle.Interior.Color = RGB(0, 255, 0)
Case Is = "Leihgerät"
rngZelle.Interior.Color = RGB(255, 255, 153)
Case Is Range("W2")
rngZelle.Interior.Color = RGB(255, 0, 0)
End Select
Next
End Sub