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

更新：这适用于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

Answer 3

添加＆＃34;列：= 1＆＃34;你的代码。通过这样做，自动选择范围的第一列：

With ActiveSheet

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

End With

Excel VBA自动删除重复项

3 个答案:

更新：这适用于Mac OS

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