Excel VBA 自动删除重复项

Question

我正在尝试从表格中复制一列并将其粘贴，这样做时会删除重复的单元格。我正在使用此代码：

Sub Median()

    Application.Calculation = xlManual
    Application.ScreenUpdating = False

    Worksheets("Distance to Default").Activate

With ActiveSheet

    .Range("C:C").Copy Destination:=.Range("T:T")
    .Range("T:T").RemoveDuplicates , Header:=xlNo

End With

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

End Sub

msgbox

如果不是因为出现一个 msgbox 要求我选择要删除重复项的列（上图），它会正常工作。由于我只粘贴一列，所以这个问题没有意义。

如何更改我的代码以使该框不再出现？

Obs.：我曾尝试在 RemoveDuplicates 之后使用 Columns:=1，但它不起作用

Answer 1

如果您使用Application.DisplayAlerts = False，则不应出现 msgbox。

正如我在上面的评论中提到的，当我使用您的示例时，我没有收到警告，但此代码通常会抑制显示警报。

Answer 2

将“Columns:=1”添加到您的代码中。这样做会自动选择范围的第一列：

With ActiveSheet

.Range("C:C").Copy Destination:=.Range("T:T")
.Range("T:T").RemoveDuplicates, Columns:=1, Header:=xlNo

End With

Answer 3

更新：这将在 Mac OS 上运行

Sub MacRemoveDuplicates()
    Dim Data, UniqueData, v
    Dim x As Long

    Dim c As Collection
    Set c = New Collection

    With ActiveSheet

        Data = Intersect(.Range("C:C"), .UsedRange)
        ReDim UniqueData(1 To UBound(Data, 1), 1 To 1)

        For Each v In Data
            If v <> vbNullString Then
                On Error Resume Next
                c.Add vbNullString, v

                If Err.Number = 0 Then
                    x = x + 1
                    UniqueData(x, 1) = v
                End If
                On Error GoTo 0
            End If
        Next

        .Range("T1").Resize(x) = UniqueData
    End With
End Sub

以下是使用 Windows 操作系统删除重复项的两种方法。

Sub Method1()

    With ActiveSheet
        .Range("C:C").Copy Destination:=.Range("T:T")
        .Range("T:T").RemoveDuplicates Columns:=1, Header:=xlNo
    End With

End Sub


Sub Method2()
    Dim Data, v
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    With ActiveSheet

        Data = Intersect(.Range("C:C"), .UsedRange)

        For Each v In Data
            If v <> vbNullString Then dict(v) = vbNullString
        Next

        .Range("T1").Resize(dict.Count) = Application.Transpose(dict.Keys)
    End With
End Sub