Zwei Worksheet_Change Makros in einem Worksheet ausführen

[DrMinzlauer]

Hallo Zusammen,
ich musste für die Arbeit ein Makro programmieren, dieses funktioniert einzeln auch.
Nun habe ich das Problem, dass in dem Excel schon ein anderes Makro mit "Worksheet_Change" existiert, welches nicht von mir ist und mir die Funktion nicht bekannt ist.
Wenn ich Beispielsweise mein 2tes makro mit "Worksheet_SelectionChange" ausführe funktioniert alles.
Allerdings wäre Worksheet_Change deutlich besser und Slection Change ist nicht optimal.

Was muss ich tun um beide Makros in einem Worksheet ausführen zu können?

Kurze erklärung was Makro 2 macht:
Immer wenn ein neuer Name in Spalte E auftaucht, soll Excel das Datum aus Spalte C überprüfen und wenn der Name das erste Mal in einer Kalenderwoche notiert wurde,
soll eine automatische Nachricht in Spalte J geschrieben werden.

Private Sub Worksheet_Change(ByVal Target As Range)
Set NewTarget = Intersect(Target, Range("A:A"))
If NewTarget Is Nothing Then
Set NewTarget = Intersect(Target, Range("L:L"))
If NewTarget Is Nothing Then Exit Sub

Cells(Target.Row, "M") = Now
Exit Sub
End If

If Cells(Target.Row, "A").Value <> "" Then
Cells(Target.Row, "C") = Now
Cells(Target.Row, "D") = Now
Else
Cells(Target.Row, "C") = ""
Cells(Target.Row, "D") = ""
End If
End Sub
'Rauheit muss geprüft werden
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim LastRow As Long
Dim i As Long
Dim Name As String
Dim Week As Integer
Dim FirstDate As Date
Dim Found As Boolean

' Überprüfen, ob Änderungen in Spalte E vorgenommen wurden
If Target.Column <> 5 Then Exit Sub

' Letzte Zeile in Spalte E finden
LastRow = Cells(Rows.Count, "E").End(xlUp).Row

' Für jede neue Zeile in Spalte E
For i = Target.Row To LastRow
' Name in Spalte E
Name = Cells(i, "E").Value

' Datum in Spalte C
FirstDate = Cells(i, "C").Value

' Kalenderwoche des Datums
Week = Format(FirstDate, "ww")

' Überprüfen, ob der Name bereits in dieser Kalenderwoche aufgetaucht ist
Found = False
For j = 10 To i - 1
If Cells(j, "E").Value = Name And Format(Cells(j, "C").Value, "ww") = Week Then
Found = True
Exit For
End If
Next j

' Wenn der Name das erste Mal in dieser Kalenderwoche aufgetaucht ist
If Not Found Then
' Nachricht in Spalte J schreiben
Cells(i, "J").Value = "nötig "
End If
Next i
End Sub

 

[Joe4]

(Übersetzt von Google Translate)
Willkommen im Vorstand!

Wie Sie vielleicht bereits wissen, können Sie in Excel nicht mehrere Prozeduren mit demselben Namen verwenden. Sie können also nicht zwei „Worksheet_Change“-Prozeduren im selben Modul haben. Sie können jedoch zwei separate Codeblöcke in derselben Prozedur einfügen (übereinander). Es würde etwa so aufgebaut sein:

Private Sub Worksheet_Change(ByVal Target As Range)

'***Block-1-Code***
'Ihr erster Codeblock hier

'***Block-2-Code***
'Ihr zweiter Codeblock hier

End Sub

Die einzige andere Änderung, die Sie wahrscheinlich vornehmen müssten, besteht darin, alle Zeilen im ersten Block zu entfernen, die das Sub verlassen, da Sie dadurch wahrscheinlich nie zum zweiten Codeblock gelangen würden.

Anstatt also so etwas zu haben, werden Sie dadurch aufgefordert, die Prozedur zu beenden, wenn der Wert nicht in diesem Bereich gefunden wird:

Set NewTarget = Intersect(Target, Range("L:L"))
If NewTarget Is Nothing Then Exit Sub

Sie würden so etwas tun und ihm sagen, was zu tun ist, WENN es im Bereich liegt:

Set NewTarget = Intersect(Target, Range("L:L"))
If Not NewTarget Is Nothing Then
'   Deinen Code hier
End If

Hoffentlich hilft das!

 

[DrMinzlauer]

Vielen Dank!
Ich bin erst Mittwoch wieder in der Arbeit und werde es dann sofort testen!

 

[Joe4]

Du bist herzlich Willkommen!

 

[DrMinzlauer]

Habe es etwas anders gemacht und jetzt funktioniert auch alles.
Danke für die Hilfe!
Der vollständigkeit halber hier der richtige, bzw. funktionierende Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
Dim i As Long, j As Long
Dim Name As String
Dim Week As Integer
Dim FirstDate As Date
Dim Found As Boolean

Select Case Target.Column
Case 1 'Änderung in Spalte A
If Target.Value <> "" Then
Target.Offset(0, 2).Value = Now
Target.Offset(0, 3).Value = Now
Else
Target.Offset(0, 2).Value = ""
Target.Offset(0, 3).Value = ""
End If
Case 5 'Änderung in Spalte E
' Letzte Zeile in Spalte E finden
LastRow = Cells(Rows.Count, "E").End(xlUp).Row
' Für jede neue Zeile in Spalte E
For i = Target.Row To LastRow
' Name in Spalte E
Name = Cells(i, "E").Value
' Datum in Spalte C
FirstDate = Cells(i, "C").Value
' Kalenderwoche des Datums
Week = Format(FirstDate, "ww")
' Überprüfen, ob der Name bereits in dieser Kalenderwoche aufgetaucht ist
Found = False
For j = 10 To i - 1
If Cells(j, "E").Value = Name And Format(Cells(j, "C").Value, "ww") = Week Then
Found = True
Exit For
End If
Next j
' Wenn der Name das erste Mal in dieser Kalenderwoche aufgetaucht ist
If Not Found Then
' Nachricht in Spalte J schreiben
Cells(i, "J").Value = "nötig "
End If
Next i
Case 12 'Änderung in Spalte L
Cells(Target.Row, "M") = Now

End Select
End Sub

 

[Greg Truby]

(Mein Deutsch ist NICHT so gut. Die Übersetzung erfolgt durch Google, bitte verzeihen Sie etwaige Fehler.)

Willkommen im MrExcel-Forum.

Wenn Ihr Code die gewünschten Ergebnisse liefert, empfehle ich keine Änderungen am Hauptteil.

Ich würde empfehlen, sich davor zu hüten, ein CHANGE-Ereignis auszulösen, wenn Sie sich in einem CHANGE-Ereignishandler befinden.

Wenn Sie einen Haltepunkt in Ihrem Code festlegen und ihn mit der Taste F8 schrittweise ausführen, wird dies angezeigt. Nutzen Sie das Call-Stack-Fenster, während Sie sehen, wie der Code ein zweites Mal zurückläuft.

Daher ist es ratsam, jedes Mal, wenn Sie Zellwerte innerhalb eines CHANGE-Ereignishandlers ändern, die .EnableEvents-Eigenschaft der Excel-Anwendung umzuschalten.

Hier ist ein Ausschnitt Ihres Codes, der mit dieser Vorsichtsmaßnahme neu geschrieben wurde:

Private Sub Worksheet_Change(ByVal Target As Range)

Rem «snipped»

Select Case Target.Column

    Case 1 'Change in column A

       '// Turning off the .EnableEvents property will prevent raising
       '// recursive Change events.
        Application.EnableEvents = False

        If Target.Value <> "" Then
            '// this statement raises a SECOND CHANGE event
            Target.Offset(0, 2).Value = Now
            '// this statement raises a THIRD CHANGE event
            '// (call stack is two-deep because second change event
            '// gets handled completely before execution gets to
            '// this statement)
            Target.Offset(0, 3).Value = Now
    
        else
        
            '// this statement raises a SECOND CHANGE event
            Target.Offset(0, 2).Value = ""
            '// this statement raises a THIRD CHANGE event
            '// (call stack is two-deep because second change event
            '// gets handled completely before execution gets to
            '// this statement)
            Target.Offset(0, 3).Value = ""
    
        End If

        '// Just be sure to turn it back on when you are done with
        '// those statements that would have raised recursive Change events.
        Application.EnableEvents = True

End Select

Rem «snipped»

end sub