案例选择语句使 Excel 崩溃

Question

请耐心等待，我正在学习 Excel VBA，所以请原谅任何狡猾的代码。这个让我很难过——我确定我遗漏了一些很明显的东西，但我就是看不到！

我正在尝试将我的代码从扩展的 IF（有效）改进为调用预定义宏的 Select Case。

下面的代码似乎可以运行并执行我希望它执行的操作，但是在调用代码或描述宏时会导致 Excel 崩溃并显示“Microsoft Excel 已停止工作”。调用 Freetype 宏时，我得到“没有足够的系统资源来完全显示”

主工作表代码

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim OrderBox As String
    OrderBox = Range("E3")
        Select Case OrderBox
            Case "Order by Description"
                Call UnProtect(1234)
                Call Description
                Call Protect(1234)
            Case "Order by Code"
                Call UnProtect(1234)
                Call Code
                Call Protect(1234)
            Case "Free Type"
                Call UnProtect(1234)
                Call Freetype
                Call Protect(1234)
        End Select
End Sub

这是我的宏：

Sub Protect(myPassword As String)
    ActiveWorkbook.Sheets.Protect
    Password = myPassword
    ActiveWorkbook.Protect
    Password = myPassword
End Sub

Sub UnProtect(myPassword As String)
    ActiveWorkbook.ActiveSheet.UnProtect
    Password = myPassword
    ActiveWorkbook.UnProtect
    Password = myPassword
End Sub

Sub Description()
    Dim Range1 As Range, Range2 As Range, Range3 As Range
    Set Range1 = Range("A18:B23")
    Set Range2 = Range("A18:A23")
    Set Range3 = Range("B18:B23")
    Range1.Locked = False
        Range1.Validation.Delete
            Range3.Select
            With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=indirect(""databydesc[description]"")"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
            End With
    Range2.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[1],DATABYDESC,2,FALSE),"""")"
    Range3.ClearContents
        Range2.Locked = True
        Range("B18").Select
End Sub

Sub Code()
    Dim Range1 As Range, Range2 As Range, Range3 As Range
    Set Range1 = Range("A18:B23")
    Set Range2 = Range("A18:A23")
    Set Range3 = Range("B18:B23")
    Range1.Locked = False
        Range1.Validation.Delete
            Range2.Select
            With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=indirect(""databycode[code]"")"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
            End With
    Range3.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],DATABYCODE,2,FALSE),"""")"
    Range2.ClearContents
        Range3.Locked = True
        Range("A18").Select
End Sub

Sub Freetype()
    Range("A18:B23").Locked = False
        Range("A18:B23").Validation.Delete
        Range("A18:B23").ClearContents
    Range("B18").Select
    Range("A18").Select
End Sub

感谢任何关于我哪里出错的建议或建议。

Answer 1

一个可能的原因是您在 Worksheet_Change 事件中调用的例程写入工作表并重新触发事件。

这可能会有所帮助

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim OrderBox As String
Application.EnableEvents = false
    OrderBox = Range("E3")
        Select Case OrderBox
            Case "Order by Description"
                Call UnProtect(1234)
                Call Description
                Call Protect(1234)
            Case "Order by Code"
                Call UnProtect(1234)
                Call Code
                Call Protect(1234)
            Case "Free Type"
                Call UnProtect(1234)
                Call Freetype
                Call Protect(1234)
        End Select
Application.EnableEvents = true
End Sub

Answer 2

Cirrusone - 您的回答完全解决了崩溃问题，但阻止了我从应用于宏范围的数据验证列表中进行选择。它只是不允许将任何内容添加到这些单元格中（我认为每次更改单元格时它都会再次调用宏 - 其中一部分是该范围内的 .ClearContents）

我想出了我需要在哪里添加一行代码来阻止崩溃 - 我需要添加一个 With Target，然后使用 If 给 .Address 以引用“OrderBox”单元格，以便我们只寻找该单元格（E3）中的变化（我认为..？）。

如果有人想进一步向我解释，那对我的学习很有帮助。

如下更新似乎有效...

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim OrderBox As String
    OrderBox = Range("E3")
    With Target
        If .Address = ("$E$3") Then
            Select Case OrderBox
                Case "Order by Description"
                    Call UnProtect(1234)
                    Call Description
                    Call Protect(1234)
                Case "Order by Code"
                    Call UnProtect(1234)
                    Call Code
                    Call Protect(1234)
                Case "Free Type"
                    Call UnProtect(1234)
                    Call Freetype
                    Call Protect(1234)
            End Select
        End If
    End With
End Sub