试图从 VBA 文本框中删除自动添加和排序的答案到 excel 单元格中

Question

我有添加代码，如果根据特定标准提供答案，它会将自己添加到列表中。由于我一直在对程序的其余部分进行故障排除，所以我积累了很多已添加的答案。如果我 select 单元格闪烁进出，如果我尝试手动删除它，它会卡在 'loop' 中，为了做任何事情我都必须崩溃 excel。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'sorts supervisor add list
Const myCol As String = "H"
Const N As Long = 2
Dim r As Long
If Not Intersect(Target, Range(myCol & ":" & myCol)) Is Nothing Then
r = Cells(Rows.Count, myCol).End(xlUp).Row
If r < N Then r = N
With Sheet2.Sort
.SortFields.Clear
.SortFields.add Key:=Range(myCol & N), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range(myCol & N & ":" & myCol & r)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For x = r To N + 1 Step -1
If Cells(x, myCol).Value = Cells(x - 1, myCol).Value Then Cells(x, _ myCol).Delete shift:=xlUp
Next 
End If

错误似乎发生在

If Cells(x, myCol).Value = Cells(x - 1, myCol).Value Then Cells(x, _ myCol).Delete shift:=xlUp

删除重复项时也有问题。

Answer 1

如果您可能触发正在处理的事件，通常建议在事件处理代码中禁用事件。

Delete 将导致选择更改，从而再次触发此事件。 See this excellent post on the topic。

要解决，请在开头添加 Application.EnableEvents = False，然后在结尾添加 True。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Application.EnableEvents = False
    '...your code here
    Application.EnableEvents = True

End Sub

试图从 VBA 文本框中删除自动添加和排序的答案到 excel 单元格中

trying to delete automatically added and sorted answers from a VBA textbox into excel cells

excel

vba

add

duplicates