如何添加 VBA 代码以从 excel 中删除重复项 [重复]

Question

例如，我有 2 张纸（第 1 和第 2 张）。我会将工作表 2 中的一些数据复制到工作表 1。

之后我需要从列中删除重复值。

我的代码是：

Sub Button1_Click()
    Dim excel As excel.Application
    Dim wb As excel.Workbook
    Dim sht As excel.Worksheet
    Dim f As Object

    Set f = Application.FileDialog(3)
    f.AllowMultiSelect = False
    f.Show

    Set excel = CreateObject("excel.Application")
    Set wb = excel.Workbooks.Open(f.SelectedItems(1))
    Set sht = wb.Worksheets("Query1") 

'((((((选择表2)))))

    sht.Activate
    sht.Columns("A:D").Copy '(((((copy from sheet2))))
    Range("I5").PasteSpecial Paste:=xlPasteValues '(((((paste in sheet1))))

    sht.Activate
    sht.Columns("F:H").Copy '(((((copy from sheet2))))
    Range("Q5").PasteSpecial Paste:=xlPasteValues  '(((((paste in sheet1))))

    wb.Close

End Sub

例如，我需要知道从 B 列 - sheet1 中删除重复值的代码和位置。

谢谢

Answer 1

请尝试一下。 Sheets(1).Range(Range("B1"), Range("B1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo.

Answer 2

如果您希望整个文件相同（重复值被删除，但剩余值的位置不变），那么此代码将起作用：

注意：您需要添加对 Microsoft Scripting Runtime 的引用才能使用字典对象

Sub removeDuplicatesFromColumn(columnIndex As Integer)
    On Error GoTo ErrorHandler
    Dim rowIndex As Integer
    Dim columnValues As Dictionary
    Set columnValues = New Dictionary

    'I've set this up backwards in case you want to remove rows/cells that are duplicates
    For rowIndex = 1 To ActiveSheet.UsedRange.Rows.Count
        If columnValues.Exists(Cells(rowIndex, columnIndex).Value) Then
            Cells(rowIndex, columnIndex).Value = ""
        Else
            columnValues.Add Cells(rowIndex, columnIndex).Value, ""
        End If
    Next rowIndex

    Exit Sub
ErrorHandler:
    MsgBox Err.Description
    'resume
End Sub