Question

请耐心等待，我正在学习Excel VBA，因为我可以为任何狡猾的代码辩解。这个刚刚让我难过 - 我确定我错过了一些非常明显的东西但是我看不到它！

我正在尝试将我的代码从扩展的IF（可以工作）改进为Select Case with Calls to predefined macros。

以下代码似乎运行并执行我想要它执行的操作，但在调用代码或描述宏时，“Microsoft 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

案例选择语句崩溃Excel

2 个答案: