Thema Datum  Von Nutzer Rating
Antwort
26.05.2023 13:26:09 Simon
NotSolved
Blau 2 Worksheet_Change Makros in einem Worksheet
26.05.2023 14:01:14 Der Steuerfuzzi
NotSolved
26.05.2023 14:22:34 Simon
NotSolved
26.05.2023 14:33:43 Der Steuerfuzzi
*****
Solved
31.05.2023 11:04:46 Simon
NotSolved
26.06.2023 08:58:32 Simon
NotSolved
26.06.2023 09:04:48 Simon
NotSolved

Ansicht des Beitrags:
Von:
Der Steuerfuzzi
Datum:
26.05.2023 14:01:14
Views:
285
Rating: Antwort:
  Ja
Thema:
2 Worksheet_Change Makros in einem Worksheet

Hallo,

 

es gibt nur ein Worksheet_Change-Ereignis. Dementsprechend musst Du beide Codes in dieser einen Ereignisprozedur unterbringen.

 

Schnelle Lösung: Da die zweite Prozedur nur bei Spalte 5 laufen soll, kannst Du Deinen Code einfach davor schreiben:

'Rauheit muss geprüft werden
Private Sub Worksheet_Change(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

    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

    ' Ü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

Aber:

1. Dein Code deklariert keine Variablen (im Gegensatz zum zweiten Code) - nicht empfehlenswert (Option Explicit ist sicher keine schlechte Idee)

2. In Deinem Code wird ein Teil immer ausgeführt, auch wenn die Änderung nicht in Spalte A stattfindet. Vermutlich ist das nicht gewollt.

3. Man sollte den Code sinnvol aufbauen und eine klare Struktur herstellen. Daher ist das einfach reinkopieren mE nicht der sinnvolste Weg. Eventuell ist hier die Verwendung von Select...Case wesentlich übersichtlicher

 

 

Gruß

Michael


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
26.05.2023 13:26:09 Simon
NotSolved
Blau 2 Worksheet_Change Makros in einem Worksheet
26.05.2023 14:01:14 Der Steuerfuzzi
NotSolved
26.05.2023 14:22:34 Simon
NotSolved
26.05.2023 14:33:43 Der Steuerfuzzi
*****
Solved
31.05.2023 11:04:46 Simon
NotSolved
26.06.2023 08:58:32 Simon
NotSolved
26.06.2023 09:04:48 Simon
NotSolved