对macros和数据validationmacros进行sorting

我的计划是在特定工作表（List）上input数据，并按字母顺序自动sorting，然后在第一张工作表（TicketSheet）上创build一个数据validation。

当我input任何date和保存时，我无法再打开文件，因为它崩溃。

我开发了以下代码：

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("$A:$F")) Is Nothing Then Dim x As Range Set x = Cells(2, Target.Column) Dim y As Range Set y = Cells(1000, Target.Column) If Target.Column = 1 Or Target.Column = 4 Or Target.Column = 6 Then Range(x, y).Sort Key1:=Target, Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom End If End If Call AddData Call AddData1 Call AddData2 End Sub Sub AddData() Dim Lrow As Single Dim Selct As String Dim Value As Variant Lrow = Worksheets("List").Range("A" & Rows.Count).End(xlUp).Row For Each Value In Range("A2:A" & Lrow) Selct = Selct & "," & Value Next Value Selct = Right(Selct, Len(Selct) - 1) With Worksheets("TicketSheet").Range("C4").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=Selct .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End Sub Sub AddData1() Dim Lrow1 As Single Dim Selct1 As String Dim Value As Variant Lrow1 = Worksheets("List").Range("D" & Rows.Count).End(xlUp).Row For Each Value In Range("D2:D" & Lrow1) Selct1 = Selct1 & "," & Value Next Value Selct1 = Right(Selct1, Len(Selct1) - 1) With Worksheets("TicketSheet").Range("C3").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=Selct1 .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End Sub Sub AddData2() Dim Lrow2 As Single Dim Selct2 As String Dim Value As Variant Lrow2 = Worksheets("List").Range("F" & Rows.Count).End(xlUp).Row For Each Value In Range("F2:F" & Lrow2) Selct2 = Selct2 & "," & Value Next Value Selct2 = Right(Selct2, Len(Selct2) - 1) With Worksheets("TicketSheet").Range("C5").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=Selct2 .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End Sub] 

Answer 1

首先，您需要禁用事件。 Worksheet_Change事件macros由值的更改触发。 如果要开始更改Worksheet_Change中的值，则禁用事件将会停止macros触发自身。

此外， 目标是已更改的单元格或单元格。 你的代码不允许后者; 它只处理Target是单个单元格的情况。 目前，放弃很大的变化（如行删除或sorting操作）。

 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("$A:$F")) Is Nothing Then On Error GoTo bm_Safe_Exit Application.EnableEvents = False Dim x As Range, y As Range Set x = Cells(2, Target.Column) Set y = Cells(1000, Target.Column) If Target.Column = 1 Or Target.Column = 4 Or Target.Column = 6 Then 'you really should know if you have column header labels or not Range(x, y).Sort Key1:=Target, Order1:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom Call AddData Call AddData1 Call AddData2 End If End If bm_Safe_Exit: Application.EnableEvents = True End Sub 

这应该让你开始。 稍后我会更深入地研究你的其他子程序，但是我会说你好像有很多事情是由Worksheet_Change开始的。