Sort macro and data validation macro

问题:

My plan is to enter data on a specific sheet(List) and automatically sort by alphabetical order, then create a data validation on the first sheet (TicketSheet).

When I enter any date and save I can't open the file again because it crashes.

I developed the following code:

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] 

回答1:

First off, you need to disable events. The Worksheet_Change event macro is triggered by a change of values. If you are going to start changing values inside a Worksheet_Change then disabling events stops the macro from triggering itself.

Additionally, the Target is the cell or cells that have been changed. Your code does not allow for the latter; it only deals with situations where Target is a single cell. For the time being, discard large changes (like those in a row deletion or sort operation).

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 

That should get you started. I will look deeper into your other sub procedures later but I will remark that it seems like you have an awful lot going on to have initiated by a Worksheet_Change.

文章来源: Sort macro and data validation macro