2x Worksheet_Change kombinieren.

[Silverstream]

Guten Abend,

gibt es eine Möglichkeit 2x Private Sub Worksheet_Change(ByVal Target As Range) zu verwenden/kombinieren?

Nr1

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim Bereich As Range
Set Bereich = Intersect(Target, Range("F2:F2000"))
If Not Bereich Is Nothing Then
    For Each Zelle In Bereich
        'Code für Bereich f:f
        If Zelle = "" Then
            Zelle.Offset(, 1).ClearContents
        Else
            Zelle.Offset(, 1) = Now
        End If
    Next Zelle
End If
Set Bereich = Intersect(Target, Range("H2:H2000"))
If Not Bereich Is Nothing Then
    For Each Zelle In Bereich
        'Code für Bereich H:h
        If Zelle = "" Then
            Zelle.Offset(, 1).ClearContents
        Else
            Zelle.Offset(, 1) = Now
        End If
    Next Zelle
End Sub


Nr2

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim SpNr As Long
  SpNr = Target.Column
  If SpNr = 6 Or SpNr = 8 Then
      ProtokollSchreiben Target
  End If
End Sub



Danke schonmal

Grüße

Silver

[Klaus-Dieter]

Hallo,

das kannst du nur dahingehend kombinieren, dass du beide Programmteile in einen zusammen führst.

[Silverstream]

Okay, danke für die schnell Antwort.

Hätte da jemand einen Tipp für mich wie das ausschauen kann?

Der erste Code schreibt mir in die Zelle rechts daneben das aktuelle Datum, falls ein Zelleintrag vorhanden.
Der zweite Code führt ein Modul nur aus wenn Änderungen in Spalte 6 oder 8 gemacht wurden.

Danke schonmal

Grüße

Silver

[Steffl]

Hallo,

vielleicht so?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim Bereich As Range
Dim SpNr As Long
Set Bereich = Intersect(Target, Union(Range("F2:F2000"), Range("H2:H2000")))
If Not Bereich Is Nothing Then
    For Each Zelle In Bereich
        'Code für Bereich f:f
        If Zelle = "" Then
            Zelle.Offset(, 1).ClearContents
        Else
            Zelle.Offset(, 1) = Now
        End If
    Next Zelle
End If
SpNr = Target.Column
If SpNr = 6 Or SpNr = 8 Then
    ProtokollSchreiben Target
End If
End Sub

[BoskoBiati]

Hi,

für meine Begriffe reicht es, diesen Teil aus dem zweiten Makro:

Code:

Dim SpNr As Long
  SpNr = Target.Column
  If SpNr = 6 Or SpNr = 8 Then
      ProtokollSchreiben Target
  End If

in das erste Makro nach

Dim Bereich As Range

einzusetzen!

[Silverstream]

Recht herzlichen Dank für die Antworten!

Hab das jetz wie BoskoBiati gemeint hatte eingefügt und es klappt.

Grüße

Silver