2 Codes in one Sheet

[Enrico]

Hallo ... laut Google kann ich nicht 2 VBA-Codes in einem Worksheet ausführen.

Wie kann ich das Problem am besten lösen?

Für jeden Code ein eigenes Modul erstellen?

Was muss ich aber dann tun damit Modul1 und Modul1 für das selbe Blatt ausgeführt wird?

Aktuell laufen beide Codes ohne Button etc. sondern funktionieren eben bei Eingabe.
(1x Zelle immer Text auch wenn "leer" und 1x Eintragung Zeit sobald Text in Zelle eingetragen wird)

Leider funktioniert es eben nur unabhängig voneinander .... 

[HKindler]

Hi,

natürlich kann man im Code-Modul eines Arbeitsblattes nur eine gleichnamige Funktion haben. Das gilt für alle Module.

Ich vermute mal, du hast Bedarf für zwei verschiedene Worksheet_Change-Events. Dann kopiere doch einfach beide zusammen. Wenn sie gut genug programmiert sind, funktioniert das ohne Probleme. Wenn nicht, solltest du die beiden Codes hier rein stellen, dann kann man das anpassen.

[Enrico]

Hallo,

anbei die 2 Codes. Ich denke das wird dir bekannt vorkommen...

Code 1

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("F6:F46,M6:M57,T6:T44")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
    If Target = "" Then
        Target.Offset(0, 1).ClearContents
    Else
        Target.Offset(0, 1) = Format(Now, "hh:mm")
       
    End If
   
End Sub

Code 2

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Bereich As Range
Dim Zelle As Range
Dim temp As Variant
Dim Vorlage As Worksheet
Set Vorlage = Worksheets(Me.Name & "_V")
Set Bereich = Intersect(Target, Me.Range(Vorlage.UsedRange.Address))
If Not Bereich Is Nothing Then
    For Each Zelle In Bereich.Cells
        If IsEmpty(Zelle) Then
            temp = Vorlage.Range(Zelle.Address)
            If Not IsEmpty(temp) Then
                Application.EnableEvents = False
                On Error Resume Next
                Zelle = temp
                On Error GoTo 0
                Application.EnableEvents = True
            End If
        End If
    Next Zelle
End If
End Sub

Beides soll in dem selben Arbeitsblatt ausgeführt werden.


Nachtrag:

Hab das gemacht was du gesagt hast und einfach mal versucht zusammen zu führen:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Bereich As Range
Dim Zelle As Range
Dim temp As Variant
Dim Vorlage As Worksheet
Set Vorlage = Worksheets(Me.Name & "_V")
Set Bereich = Intersect(Target, Me.Range(Vorlage.UsedRange.Address))
If Not Bereich Is Nothing Then
    For Each Zelle In Bereich.Cells
        If IsEmpty(Zelle) Then
            temp = Vorlage.Range(Zelle.Address)
            If Not IsEmpty(temp) Then
                Application.EnableEvents = False
                On Error Resume Next
                Zelle = temp
                On Error GoTo 0
                Application.EnableEvents = True
            End If
        End If
    Next Zelle
End If

    If Intersect(Target, Range("F6:F46,M6:M57,T6:T44")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
    If Target = "" Then
        Target.Offset(0, 1).ClearContents
    Else
        Target.Offset(0, 1) = Format(Now, "hh:mm")
       
    End If
   
End Sub

Das hat echt funktioniert, jetzt gehen beide Funktionen so wie es aussieht. 

[HKindler]

Hi,

da hast du aber Glück gehabt, dass du meinen Code vorne hin gesetzt hast. Umgekehrt wäre es nicht gegangen, da der zweite Code rigoros abbricht, falls seine Bedingungen nicht erfüllt sind. Dabei ist es ihm egal, ob weiter hinten noch weitere Bedingungen für andere Bereiche kommen.

Korrekt könnte es so aussehen:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Bereich As Range
Dim Zelle As Range
Dim temp As Variant
Dim Vorlage As Worksheet
Set Vorlage = Worksheets(Me.Name & "_V")
Set Bereich = Intersect(Target, Me.Range(Vorlage.UsedRange.Address))
If Not Bereich Is Nothing Then
    For Each Zelle In Bereich.Cells
        If IsEmpty(Zelle) Then
            temp = Vorlage.Range(Zelle.Address)
            If Not IsEmpty(temp) Then
                Application.EnableEvents = False
                On Error Resume Next
                Zelle = temp
                On Error GoTo 0
                Application.EnableEvents = True
            End If
        End If
    Next Zelle
End If

If Not Intersect(Target, Range("F6:F46,M6:M57,T6:T44")) Is Nothing Then
    If Target.Count = 1 Then
        If Target = "" Then
            Target.Offset(0, 1).ClearContents
        Else
            Target.Offset(0, 1) = Format(Now, "hh:mm")
        End If
    End If
End If
End Sub

Habe jetzt nur mal die Abfrage der einzelnen Bedingungen in der zweiten Hälfte verändert, so dass eventuell folgende weitere Codes verarbeitet werden können. Allerdings hat der zweite Code noch einige Nachteile. So wird die gleichzeitige Verarbeitung von mehreren Zellen nicht unterstützt. Außerdem wird nur ein Text in die Nachbarzelle geschrieben, der wie eine Uhrzeit aussieht. Mit einem Text kann aber nicht vernünftig weiter gearbeitet werden. Außerdem wird durch das Schreiben in eine Zelle das Change-Ereignis erneut ausgelöst. Oft führt das zu einer Endlosschleife, hier eher nicht. Aber schön ist das nicht.

Ich würde das Ganze so schreiben:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim Zelle As Range
Dim temp As Variant
Dim Vorlage As Worksheet
Set Vorlage = Worksheets(Me.Name & "_V")
Set Bereich = Intersect(Target, Me.Range(Vorlage.UsedRange.Address))
If Not Bereich Is Nothing Then
    Application.EnableEvents = False
    On Error Resume Next
    For Each Zelle In Bereich.Cells
        If IsEmpty(Zelle) Then
            temp = Vorlage.Range(Zelle.Address)
            If Not IsEmpty(temp) Then
                Zelle = temp
            End If
        End If
    Next Zelle
    On Error GoTo 0
    Application.EnableEvents = True
End If
Set Bereich = Intersect(Target, Range("F6:F46,M6:M57,T6:T44"))
If Not Bereich Is Nothing Then
    Application.EnableEvents = False
    On Error Resume Next
    For Each Zelle in Bereich
        If Zelle = "" Then
            Zelle.Offset(0, 1).ClearContents
        Else
            Zelle.Offset(0, 1) = Now
        End If
    Next Zelle
    On Error GoTo 0
    Application.EnableEvents = True
End If
End Sub

Ich habe auch mal noch das Abschalten der Events im ersten Teil weiter nach außen gepackt. Das ist noch ein klein wenig resourcenschonender. Dies wirkt sich allerdings nur minimal aus und nur dann, wenn viele Zellen mit "Vorbelegung" gleichzeitig gelöscht werden.
Die Zellen in G, N und S musst du halt einmalig als Uhrzeit formatieren. Falls dich stört, dass das Datum mit gespeichert wird (auch wenn man es dann nicht sieht), dann schreibst du statt Now einfach Now - CLng(Now)

[Kuwer]

Die Zellen in G, N und S musst du halt einmalig als Uhrzeit formatieren.

Könnte man auch im Code erledigen. 

Falls dich stört, dass das Datum mit gespeichert wird (auch wenn man es dann nicht sieht), dann schreibst du statt Now einfach Now - CLng(Now)

Oder einfach Time nehmen.

Gruß, Uwe

[HKindler]

Hi Uwe,

klar kann man die Formatierung im Code machen. Aber wozu das jedes mal machen, wenn man es auch einfach einmalig machen kann? Vor allem kann dann der User entscheiden, ob er z.B. die Sekunden sehen will oder nicht.

Und das mit Time ist natürlich schlauer als mein Konstrukt. Liegt daran, dass ich Time nie brauche, sondern eigentlich immer mit Now arbeite, da ich i.d.R. keinen "Zeit"- sondern einen "Datum und Uhrzeit"-Stempel brauche.

[Enrico]

Vielen Dank nochmal für eure Unterstützung.

Es funktioniert alles wie gewünscht.