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

Question

例如，我有两张表(表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") 

'(((((select sheet 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