大小写select语句崩溃Excel

忍受我，我正在学习Excel VBA，因为我去借口任何狡猾的代码。 这一个刚刚难倒我 – 我敢肯定我错过了一些非常明显的东西，但我只是看不到它！

我试图从一个扩展的IF（工程）改进我的代码到一个select大小写调用预定义的macros。

下面的代码似乎运行，做我想要做的，但是当调用代码或描述macros的时候，“Microsoft Excel已停止工作”，然后崩溃Excel。 当调用Freetypemacros，我得到“没有足够的系统资源完全显示”

主要工作表代码

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 

这是我的macros：

 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 

任何build议或意见，我已经出错了感激。

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 – 你的答案完全解决了崩溃问题，但却阻止我从应用于macros中范围的数据validation列表中进行select。 它不会允许任何东西被添加到这些单元格中（我认为每次更改单元格时都会再次调用macros – 其中的一部分是.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