运行此宏后 Excel 崩溃 - 空白错误报告

Question

我正在运行这个简单的宏。目标是通过单击用户表单按钮创建新的数据表（删除旧的）。从原始数据表复制后，应将其重命名为“数据”。如果名为“数据”的工作表已经存在 - 将其删除。

Private Sub CommandButton1_Click()
Dim ws1 As Worksheet
Dim trigger As Integer

trigger = 0

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To Sheets.Count
    If Sheets(i).Name = "Data" Then
        trigger = 1
        Sheets("Data").Delete
        Sheets("raw_Data").Visible = True
    Set ws1 = Sheets("raw_Data")
    ws1.Copy Sheets(Sheets.Count)
    Sheets("raw_Data").Visible = False
    End If
Next i

If trigger = 0 Then
    Sheets("raw_Data").Visible = True
    Set ws1 = ThisWorkbook.Worksheets("raw_Data")
    ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
    Sheets("raw_Data").Visible = False
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Unload Me
    ActiveSheet.Name = "Data"
End Sub

我在这里运行某种无限循环吗？如果我删除：

    ActiveSheet.Name = "Data"

Excel 不再崩溃。

Answer 1

我和罗恩在这件事上。我做了一个更简洁的代码版本，也许它会阐明问题所在。

Option Explicit

Private Sub CommandButton1_Click()

    Const strDATA_SHEET As String = "Data"
    Const strDATA_RAW_SHEET As String = "raw_Data"

    Dim shDataRaw As Worksheet

    Call TurnExtrasOff

    ' Check if we have the sheet data if so then delete it
    If DoesWorksheetExist(strDATA_SHEET, ThisWorkbook) Then
        Application.DisplayAlerts = False
            ThisWorkbook.Sheets(strDATA_SHEET).Delete
        Application.DisplayAlerts = True
    End If

    ' Lets copy the raw data sheet.
    Set shDataRaw = ThisWorkbook.Sheets(strDATA_RAW_SHEET)
    shDataRaw.Visible = xlSheetVisible
    shDataRaw.Copy ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

    ' Rename the sheet and hide raw data
    ActiveSheet.Name = strDATA_SHEET
    shDataRaw.Visible = xlSheetHidden

    Call TurnExtrasOn

    ' Unload the user form
    Unload Me

End Sub


' Procedure to turn extra features on
Sub TurnExtrasOn()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

' Procedure to turn extra features oFF
Sub TurnExtrasOff()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationAutomatic
    End With
End Sub


' Function to check if a sheet exists
Function DoesWorksheetExist(ByVal sheetname As String, aWorkbook As Workbook) As Boolean

    On Error Resume Next
    DoesWorksheetExist = (Not aWorkbook.Sheets(sheetname) Is Nothing)
    On Error GoTo 0

End Function

希望对你有帮助