VBA Codes zusammenlegen

[mazor78]

Hallo,

Bin neu hier im Forum.

Wer könnte mir helfen die beiden Codes zusammenzulegen ?


Private Sub Worksheet_Change(ByVal Target As Range)
     If Intersect(Target, Range("E4:E1048576")) 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) = CDate(Format(Now, "dd.mm.yyyy"))
     End If
 End Sub


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If IsEmpty(Target) Then Exit Sub
    If Intersect(Target, Range("B4:H1048576")) _
       Is Nothing Then Exit Sub
    Application.EnableEvents = False
    On Error GoTo ERRORHANDLER
    Target = UCase(Target)
ERRORHANDLER:
    Application.EnableEvents = True
 End Sub

[BoskoBiati]

Hallo,

ungetestet:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
     If Intersect(Target, Range("E4:E1048576")) or Intersect(Target, Range("B4:H1048576")) Is Nothing Then Exit Sub
     If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
    Application.EnableEvents = False
If Target.Column=5 then
     If Target = "" Then
         Target.Offset(0, -1).ClearContents
         Else:
         Target.Offset(0, -1) = CDate(Format(Now, "dd.mm.yyyy"))
else
    Target = UCase(Target)
     End If
    Application.EnableEvents = true
end if
 End Sub

[atilla]

Hallo,

wenn in Spalte E auch groß geschrieben werden soll, dann so:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Intersect(Target, Range("B4:H1048576")) Is Nothing Then Exit Sub
 If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
 Application.EnableEvents = False
 If Target.Column = 5 Then
   If Target = "" Then
     Target.Offset(0, -1).ClearContents
   Else
     Target = UCase(Target)
     Target.Offset(0, -1) = CDate(Format(Now, "dd.mm.yyyy"))
   End If
 Else
     Target = UCase(Target)
 End If
 Application.EnableEvents = True
End Sub

@Edgar
Du musst nacharbeiten. Da sind noch einige Fehler drin
Is Nothing muss vor Or noch mal
Das Or muss ein And sein, sonst wirkt der Code nur in spalte E
ein End IF fehlt
Application.EnableEvents = true muss außerhalb der IF Abfrage

[Kuwer]

Hallo mazor78,

ich habe alle Exit Sub entfernt, da sie aus eben diesem Grund, dass es jeweils nur ein Ereignismakro gibt, in Ereignismakros nichts verloren haben.

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next

    Application.EnableEvents = False

    If Not Intersect(Target, Range("E4:E1048576")) Is Nothing Then

       If Target.Count = 1 Then  'Bearbeiten mehrerer Zeilen wird abgefangen

           If Target = "" Then

               Target.Offset(0, -1) = ""

           Else

               Target.Offset(0, -1) = Now

           End If

       End If

    End If

    If Not Intersect(Target, Range("B4:H1048576")) Is Nothing Then

        If Target.Count = 1 Then  'Bearbeiten mehrerer Zeilen wird abgefangen

            If Not IsEmpty(Target) Then

                Target = UCase(Target)

            End If

        End If

    End If

    Application.EnableEvents = True

    On Error GoTo 0

End Sub

Gruß Uwe

[BoskoBiati]

Hi atilla,

ok, akzeptiert.


@Uwe,

was spricht dagegen, aus dem Makro auszusteigen, wenn die Änderung nicht im festgelegten Bereich stattfindet? Soweit ich weiß, ist das gängiger Programmierstil.

[Kuwer]

Hi Edgar,

was spricht dagegen, aus dem Makro auszusteigen, wenn die Änderung nicht im festgelegten Bereich stattfindet?

schrieb ich eins drüber.

Soweit ich weiß, ist das gängiger Programmierstil.

Mit Sicherheit nicht bei Programmierern, die wissen was sie tun, denn sie verbauen/erschweren sich nicht absichtlich jedwede Änderungs-/Erweiterungsmöglichkeit.

Gruß Uwe

[atilla]

Hallo zusammen,

dann würde ich meinen Code so zusammenfassen:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
 On Error Resume Next
 Application.EnableEvents = False
 If Not Intersect(Target, Range("B4:H1048576")) Is Nothing Then
   If Target.Count = 1 Then  'Bearbeiten mehrerer Zeilen wird abgefangen
     If Target.Column = 5 Then
       If Target = "" Then
         Target.Offset(0, -1) = ""
       Else
         Target = UCase(Target)
         Target.Offset(0, -1) = CDate(Format(Date, "dd.mm.yyyy"))
       End If
     Else
       If Not IsEmpty(Target) Then
         Target = UCase(Target)
       End If
     End If
   End If
 End If
 Application.EnableEvents = True
 On Error GoTo 0
End Sub

man könnte noch über On Error Resume Next diskutieren, tun wir aber nicht.

[Kuwer]

Hallo Atilla,

ja für diesen speziellen Fall passt es gut. Wäre jetzt aber der eine Bereich statt Range("E4:E1048576")) z.B. Range("L4:L1048576"))?

Gruß Uwe

[atilla]

Hallo Uwe,

hab heute aufgepasst, nachdem ich gestern einen auf den Deckel bekommen habe.

[mazor78]

Klappt !

Super Vielen Dank ! :19: