Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Mein Arbeitsblatt hängt sich auf
#1
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 !


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
Antworten Top
#2
Hallo Carlo,

ich habe dein zweites (identisches) Thema, das wieder in einem falschen Unterforum war, ins Archiv verschoben. Bitte hier weitermachen.
Gruß Günter
Jeder Fehler erscheint unglaublich dumm, wenn andere ihn begehen.
angebl. von Georg Christoph Lichtenberg (1742-1799)
[-] Folgende(r) 1 Nutzer sagt Danke an WillWissen für diesen Beitrag:
  • Carloflip
Antworten Top
#3
Das am Anfang einfügen könnte helfen

Zitat:If Target.Cells.CountLarge > 1 Then Exit Sub
[-] Folgende(r) 1 Nutzer sagt Danke an Storax für diesen Beitrag:
  • Carloflip
Antworten Top
#4
Das war die Lösung - jetzt ist schluß mit Aufhängen. DANKE DANKE DANKE :)))
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste