Code um einen Set Bereich erweitern

[DietmarD]

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!

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

[Werner.M]

Hallo Dietmar,

so:

Code:

Set Rng = Intersect(Target, Range("D5:D60", "I5:I60"))

Gruß Werner

[DietmarD]

Hallo Werner,
da hätte ich selbst drauf kommen müssen  
Vielen Dank! Habe noch den    Zelle.Offset  auf 14 angepasst (0, 14) und funktioniert wie gewünscht! :100:

[DietmarD]

Hallo,
einen Schönheitsfehler habe ich dann doch noch.

Wenn ich meine Materialnummer aus dem vorgegebenen Set Bereich Set rng = Intersect(Target, Range("D5:D60", "I5:I60")) lösche, sollen alle gesetzten Texte und Farben wieder entfernt werden das funktionier nicht ganz korrekt, in Spalte W bleibt der Text stehen.
Muss ich das evtl. mit der -4142 einstellen?

Code:

Case Else: intIndex = -4142: Zelle.Offset(0, 19).Value = "" ' Spalte W leeren
       End Select
       If Zelle.Value <> "" Then
           Zelle.Offset(0, 21).Value = "SM4"
       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

[snb]

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  For Each it in  Intersect(Target, Range("D5:D60"))
    it.Offset(, 19)=""
   intIndex = 0

    Select Case it.Value
   Case "2069692","2068694","2069693"
      intIndex = 6
      it.Offset(, 19)="links rechts Markierung"
   End Select
  Next
End Sub

[DietmarD]

Hallo sub,

vielen Dank für deine Antwort ich habe es hinbekommen. :18: