VBA用户表单增删ListRow随机报错-2147417848求助

Hey there, let's dig into that frustrating random error you're hitting. The -2147417848 code typically points to timing conflicts or unhandled Excel state issues when working with ListObjects (tables). Let's break down your code, spot the weak points, and fix them to stop those crashes.

Key Issues in Your Current Code #

1. Unhandled Excel State in Error Handling #

Right now, if an error hits during delete/save, settings like ScreenUpdating or EnableEvents stay disabled—this can cause Excel to behave unpredictably, even crash. We need to make sure these settings get reset no matter what.

2. Fragile Range References for Table Rows #

Your save button uses hardcoded column letters (B, C, etc.) and row numbers to populate the new row. If your table's structure changes (columns added/moved), this breaks. Plus, relying on ROW()-4 for the unique ID is risky if rows get deleted later.

3. Hidden Errors with On Error Resume Next #

Using On Error Resume Next in your save button hides the root cause of the ListRows.Add failure instead of letting you handle it properly.

4. No Check for Empty Table Data #

When your table has no rows, lo.DataBodyRange will throw an error if you try to access it—this could be one of the random crash triggers.

Modified Delete Button Code #

Sub Deletebtn_Click()
    Dim lo As ListObject
    Dim cDelete As VbMsgBoxResult
    Dim num As Long
    Dim nrCol As ListColumn
    Dim targetRow As ListRow
    
    ' Initialize settings and error handling
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    On Error GoTo errHandler
    
    Set lo = Sheets("Planningdata").ListObjects("Plandatag")
    
    ' Validate input first
    If Trim(Me.Nr.Value) = "" Or Trim(Me.dagweek.Value) = "" Then
        MsgBox "There is no data to delete", vbExclamation
        GoTo cleanExit
    End If
    
    ' Confirm deletion with user
    cDelete = MsgBox("Are you sure you want to delete this data?", _
        vbYesNo + vbDefaultButton2 + vbQuestion, "Confirm Deletion")
    If cDelete <> vbYes Then GoTo cleanExit
    
    ' Find the "Nr" column safely
    Set nrCol = Nothing
    On Error Resume Next
    Set nrCol = lo.ListColumns("Nr")
    On Error GoTo errHandler
    If nrCol Is Nothing Then
        MsgBox "Column 'Nr' not found in table", vbCritical
        GoTo cleanExit
    End If
    
    ' Get the target number
    num = CLng(Me.Nr.Value)
    
    ' Check if table has data before searching
    If Not lo.DataBodyRange Is Nothing Then
        ' Loop backward to avoid index shifting issues
        For Each targetRow In lo.ListRows
            If targetRow.Range(nrCol.Index).Value = num Then
                targetRow.Delete
                Exit For ' Exit after deleting the first match (since Nr is unique)
            End If
        Next targetRow
    End If
    
cleanExit:
    ' Reset Excel settings ALWAYS
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Exit Sub
    
errHandler:
    MsgBox "An Error Occurred" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Description: " & Err.Description & vbCrLf & _
           "Please notify the administrator", vbCritical
    Resume cleanExit ' Jump to reset settings even after error
End Sub

What Changed: #

• Added Excel state resets in a dedicated cleanExit block—this ensures settings are restored even if an error occurs.
• Used ListColumn to reference the "Nr" column directly, avoiding fragile header loops.
• Checked if lo.DataBodyRange exists before searching to prevent errors on empty tables.
• Loop through ListRows directly instead of DataBodyRange for more reliable row access.
• Removed unnecessary On Error Resume Next that hid issues.

Modified Save (Add) Button Code #

Sub Savebtn_Click()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim newrow As ListRow
    Dim nextNr As Long
    
    ' Initialize settings
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    On Error GoTo errHandler
    
    Set ws = Sheets("Planningdata")
    Set tbl = ws.ListObjects("Plandatag")
    
    ' Generate a reliable unique Nr (instead of ROW()-4)
    If tbl.DataBodyRange Is Nothing Then
        nextNr = 1 ' Start at 1 if table is empty
    Else
        nextNr = WorksheetFunction.Max(tbl.ListColumns("Nr").DataBodyRange) + 1
    End If
    
    ' Add new row with error handling
    Set newrow = tbl.ListRows.Add(AlwaysInsert:=True)
    
    ' Populate the new row using table columns (no hardcoded ranges!)
    With newrow.Range
        .Cells(tbl.ListColumns("Nr").Index).Value = nextNr
        .Cells(tbl.ListColumns("Analyse").Index).Value = Me.Analyse.Value
        .Cells(tbl.ListColumns("Dag").Index).Value = Me.dagweek.Value
        .Cells(tbl.ListColumns("Combined").Index).Formula = "=CONCAT(Plandatag[@Analyse],""-"",Plandatag[@Dag])" ' Update column name to match your table
        .Cells(tbl.ListColumns("Samplenr").Index).Value = Me.Samplenr.Value
        .Cells(tbl.ListColumns("Apparaat").Index).Value = Me.Apparaat.Value
    End With
    
    ' Refresh calculation to ensure formulas update
    Application.Calculate
    
    ' Clean up and re-show form
    Unload Me
    Toevoegen.Show
    
cleanExit:
    ' Reset Excel settings
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Exit Sub
    
errHandler:
    MsgBox "An Error Occurred" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Description: " & Err.Description & vbCrLf & _
           "Please notify the administrator", vbCritical
    Resume cleanExit
End Sub

What Changed: #

• Generated a reliable unique Nr using Max(Nr column) + 1—no more dependency on row positions.
• Populated the new row using ListColumns instead of hardcoded ranges—this works even if your table columns move.
• Removed On Error Resume Next so we can catch and report the actual cause of ListRows.Add failures.
• Added Application.Calculate to ensure the CONCAT formula updates immediately.
• Included full state resets in cleanExit to prevent crashes from stuck settings.

Additional Tips to Prevent Random Errors #

1. Check Worksheet Protection: If your "Planningdata" sheet is protected, even with password, it can block ListRow operations. Unprotect the sheet temporarily during operations:

   ws.Unprotect Password:="yourPassword" ' Add before table operations
   ' ... your code ...
   ws.Protect Password:="yourPassword" ' Add in cleanExit
   

2. Avoid Rapid Form Re-loading: Unloading and re-showing Toevoegen immediately can cause memory leaks. Instead, clear the form controls and reuse the same instance:

   ' Replace Unload Me + Toevoegen.Show with:
   Me.Nr.Value = ""
   Me.Analyse.Value = ""
   ' Clear other controls...
   Me.Show ' If the form was hidden, not unloaded
   

3. Test with Debug Mode: Enable Debug.Print statements to track when errors occur, or use breakpoints to step through code during random failures.

内容的提问来源于stack exchange，提问作者Sciurus