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")

<（P>＆＃39;（（（（（选择表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 中删除重复值的代码和位置。

THKS

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

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

2 个答案: