vba - 尽管 displayalerts=false，通过 VBA 删除重复项仍然会弹出

Question

我的电子表格中的 C 列包含将由客户选择并经常更新的值。我希望 D 列动态应用从该列表中提取的数据验证。但是，它需要包含按字母顺序排列的唯一值。

我目前正在做的是使用以下公式按字母顺序对隐藏列(BK)中的这些值进行排序。 (注意:我发现这个的网站表明它应该只显示唯一值，但它没有)。

{=INDEX(List,MATCH(0,IF(MAX(NOT(COUNTIF($BK$15:BK15,List))*(COUNTIF(List,">"&List)+1))=(COUNTIF(List,">"&List)+1),0,1),0))}

要动态更新 D 列，我使用以下代码:

Dim NewRng As Range
Dim RefList As Range, c As Range, rngHeaders As Range, RefList2 As Range, msg

On Error GoTo ErrHandling


Set NewRng = Application.Intersect(Me.Range("D16:D601"), Target)
If Not NewRng Is Nothing Then

    Set rngHeaders = Range("A15:ZZ16").Find("Status List", After:=Range("E15"))
    Set RefList = Range(rngHeaders.Offset(1, 0).Address, rngHeaders.Offset(100, 0).Address)
    RefList.Copy
    RefList.Offset(0, 1).PasteSpecial xlPasteValues
    Set RefList2 = RefList.Offset(0, 1)


    Application.DisplayAlerts = False
    RefList2.RemoveDuplicates Columns:=1


    For Each c In NewRng
        c.Validation.Delete
        c.Validation.Add Type:=xlValidateList, _
                                 AlertStyle:=xlValidAlertStop, _
                                 Formula1:="=" & RefList2.Address

    Next c
End If
Application.DisplayAlerts = True
Application.EnableEvents = True

这似乎有效，除了每次我单击 D 列中的单元格时，它仍然会弹出一个名为“删除重复项”的弹出框，其中显示两个选中的复选框——“全选”和“BL 列”。它还告诉我找到了多少重复项以及将保留多少个唯一值。

我不知道为什么 displayalerts=false 没有关闭此功能，但绝对不是每次有人单击 D 列时都会触发此功能的选项。以前有人见过吗？ (顺便说一下，我在 Excel for Mac 2016 上)。

Answer 1

我仍然没有找到抑制或自动接受弹出框的方法，这会导致进一步的问题，因为这意味着我选择的 D 列中的单元格不再被选中，所以我无法从下拉菜单中选择-下列表。 但是，我想知道是否有人有任何可能比我上面的方法更简单的替代想法。

本质上，我需要实现两种不同的场景:

在上述场景中，我只需要从中提取唯一值
将 C 列放入 D 列中的数据验证下拉列表中。

我还需要根据另一个页面上的值创建下拉列表 不是 目前为列表格式。例如，在下面的代码中，我正在寻找当前位于另一个页面标题中的任何值(即单元格被合并)。现在我正在查找/复制/粘贴/验证，但这似乎很复杂。当然，它会遇到与场景 1 相同的弹出问题。

Dim EvalRng As Range
Set ws = ThisWorkbook.Sheets("Evaluation Forms")
Dim EvalList As Range, EvalList2 As Range, EvalHeader As Range

On Error GoTo ErrHandling2

Set EvalRng = Application.Intersect(Me.Range("E16:E601"), Target)
Set EvalHeader = Range("A15:ZZ16").Find("Evaluation Forms List", 
After:=Range("E15"))

If Not EvalRng Is Nothing Then

For Each c In ws.Range("A15:A105")
    If c.MergeCells Then
        c.Copy
        EvalHeader.Offset(1, 0).PasteSpecial xlPasteValues
        Set EvalHeader = EvalHeader.Offset(1, 0)
    End If


Next c

'Set EvalList = Range(EvalHeaders.Offset(1, 0).Address, EvalHeaders.Offset(100, 0).Address)
Set EvalList = EvalHeader.Offset(1, 0).End(xlDown)

EvalList.Copy
EvalList.Offset(0, 1).PasteSpecial xlPasteValues
Set EvalList2 = EvalList.Offset(0, 1)


Application.DisplayAlerts = False
Application.EnableEvents = False
EvalList2.RemoveDuplicates Columns:=Array(1), header:=xlNo


For Each c In ActionRng
    c.Validation.Delete
    c.Validation.Add Type:=xlValidateList, _
                             AlertStyle:=xlValidAlertStop, _
                             Formula1:="=" & EvalList2.Address

Next c

结束如果