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: