Case Select语句使Excel崩溃

Question

请原谅我，我正在学习Excel VBA，所以请原谅任何可疑的代码。这个问题把我难住了——我肯定我错过了一些很明显的东西，但我就是看不见!

我试图完善我的代码从一个扩展的IF(它的工作)到一个选择的情况下调用预定义的宏。

下面的代码似乎运行并做我想做的事，但当调用代码或描述宏时，崩溃Excel与"微软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