Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Code um einen Set Bereich erweitern
#1
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
Gruß
Dietmar

Damit das Mögliche entsteht, muß immer wieder das Unmögliche versucht werden.  
Antworten Top
#2
Hallo Dietmar,

so:

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


Gruß Werner
[-] Folgende(r) 1 Nutzer sagt Danke an Werner.M für diesen Beitrag:
  • DietmarD
Antworten Top
#3
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:
Gruß
Dietmar

Damit das Mögliche entsteht, muß immer wieder das Unmögliche versucht werden.  
Antworten Top
#4
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
Gruß
Dietmar

Damit das Mögliche entsteht, muß immer wieder das Unmögliche versucht werden.  
Antworten Top
#5
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
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
[-] Folgende(r) 1 Nutzer sagt Danke an snb für diesen Beitrag:
  • DietmarD
Antworten Top
#6
Hallo sub,

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

Damit das Mögliche entsteht, muß immer wieder das Unmögliche versucht werden.  
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste