Clever-Excel-Forum

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

Hallo Dietmar,

so:

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

Gruß Werner

Hallo Werner,
da hätte ich selbst drauf kommen müssen Angel

Vielen Dank! Habe noch den Zelle.Offset auf 14 angepasst (0, 14) und funktioniert wie gewünscht! :100:

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

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

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

Hallo sub,

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

DietmarD

Werner.M

DietmarD

DietmarD

snb

DietmarD