07.04.2019, 16:31
Ich habe ein Problem in meinem Programm und weiß nicht warum es harkt -
wenn ich eine Spalte oder eine Zelle in dem Blatt einfügen möchte hängt sich Excel auf.
Kann mir einer helfen das Problem zu entfernen. Das ist meine erste Frage hier im Forum !
wenn ich eine Spalte oder eine Zelle in dem Blatt einfügen möchte hängt sich Excel auf.
Kann mir einer helfen das Problem zu entfernen. Das ist meine erste Frage hier im Forum !
Code:
'**********************************
'*
'* BLATT 01
'*
'**********************************
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' --------------------------------------------------
Dim rngC, rngD, rngalt, test As Range
Dim vntAfter As Variant, vntBefore As Variant, neu As Variant
Dim strAddress As String
' --------------------------------------------------
Set rngC = Me.Range("N4:N70")
Set rngD = Me.Range("O4:O70")
strAddress = Selection.Address
vntAfter = Target.Value2
With Application
.EnableEvents = False
.ScreenUpdating = False
.Undo
End With
Range(strAddress).Select
vntBefore = Target.Value2
Target.Value2 = vntAfter
' --------------------------------------------------
On Error GoTo ErrH:
' --------------------------------------------------
'Set rngC = Me.Range("N4:N70")
If Not Intersect(Target, rngC) Is Nothing Then
Application.EnableEvents = False
Target.Offset(0, 6).Value = Target.Value ' Spalte W - Neuer Wert
Target.Offset(0, 8).Value = Date ' Spalte Y
Target.Offset(0, 9).Value = Time: ' Spalte Z
'-----------------------------------------------------------------
If IsArray(vntBefore) Then
MsgBox vntBefore(1, 1)
Else
If vntAfter = vntBefore Then neu = 0 Else neu = vntAfter - vntBefore
If neu = "" Then neu = 0
MsgBox Selection.Cells(1).Address & " " & " Alter Wert " & vntBefore & " " & " Neuer Wert " & vntAfter & " Spiele " & neu
End If
Target.Offset(0, 10).Value = vntBefore
Target.Offset(0, 11).Value = vntAfter
Target.Offset(0, 12).Value = neu
' MsgBox Selection.Cells(1).Address ' Ausgabe der Akuellen Zeile
End If
' --------------------------------------------------
'Set rngD = Me.Range("O4:O70") 'Siegrate rngD
If Not Intersect(Target, rngD) Is Nothing Then
Application.EnableEvents = False
Target.Offset(0, 6).Value = Target.Value 'Spalte U
'---------------------------------------------------------------
If vntAfter = vntBefore Then neu = 0 Else neu = vntAfter - vntBefore
If neu = "" Then neu = 0
MsgBox " Alter Wert " & Format(vntBefore, "0.00 %") & " " & " Neuer Wert " & Format(vntAfter, "0.00 %") & " Spiele " & Format(neu, "0.00 %")
' End If
Target.Offset(0, 12).Value = vntBefore ' format(wert, "0.0 %")- Format(5, "0.00%")
Target.Offset(0, 13).Value = vntAfter
Target.Offset(0, 14).Value = neu
' MsgBox Selection.Cells(1).Address ' Ausgabe der Akuellen Zeile
'---------------------------------------------------------------
End If
' --------------------------------------------------
ErrH:
Application.DisplayAlerts = True
Application.StatusBar = True
Application.EnableEvents = True
'Application.sccreenUpdating = True
'Gesamtübersichtöffnen = False
If Err.Number > 0 Then
MsgBox "Fehlermeldung - Nr.: " & Err.Number & vbLf & vbCrLf & " " & Erl & " " & Err.Description, vbInformation + vbOKOnly, "Fehler Funktion F1 "
Else: End If
Exit Sub
End Sub