Hallo zusammen,
ich habe hier einen Code der sehr gut funktioniert, nun möchte ich zu dem Set Bereich "Set rng = Intersect(Target, Range("D5:D60"))" einen weiteren Set Bereich hinzufügen der genauso arbeitet wie der vorhandene, allerdings für einen zusätzlichen Bereich I5:I60.
Wie kann ich das bewerkstelligen?
Für eure Hilfe bin ich dankbar!
ich habe hier einen Code der sehr gut funktioniert, nun möchte ich zu dem Set Bereich "Set rng = Intersect(Target, Range("D5:D60"))" einen weiteren Set Bereich hinzufügen der genauso arbeitet wie der vorhandene, allerdings für einen zusätzlichen Bereich I5:I60.
Wie kann ich das bewerkstelligen?
Für eure Hilfe bin ich dankbar!
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim Zelle As Range
Dim intIndex As Integer
Dim rng As Range
Set Bereich = Range("B5:z60")
Set rng = Intersect(Target, Range("D5:D60"))
If rng Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Zelle In rng
Select Case Zelle.Value
' falls es unterschiedlicher Text wäre
'Rechts links
Case "2069692": intIndex = 6: Zelle.Offset(0, 19).Value = "links rechts Markierung"
Case "2068694": intIndex = 6: Zelle.Offset(0, 19).Value = "links rechts Markierung"
Case "2069693": intIndex = 6: Zelle.Offset(0, 19).Value = "links rechts Markierung"
Case Else: intIndex = -4142: 'Zelle.Offset(0, 19).Value = "" ' Spalte W leeren
End Select
If Zelle.Value <> "" Then
Zelle.Offset(0, 21).Value = "SL3"
Else
Zelle.Offset(0, 21).Value = "" ' Spalte Y leeren
End If
'Zelle.Offset(0, 19).Value = "Dein Text für Alle" 'hier bei immer gleichem Text
Bereich.Rows(Zelle.Row - 4).Interior.ColorIndex = intIndex
Next
Application.EnableEvents = True
End Sub
Gruß
Dietmar
Damit das Mögliche entsteht, muß immer wieder das Unmögliche versucht werden.
Dietmar
Damit das Mögliche entsteht, muß immer wieder das Unmögliche versucht werden.