如何在 Excel (VBA) 中遍历每一列并删除重复项答案

【问题标题】：How to go through each column and remove duplicates in Excel (VB)如何在 Excel (VBA) 中遍历每一列并删除重复项
【发布时间】：2016-03-31 23:32:51
【问题描述】：

我正在查看 7776 列数据并删除重复项。

我无法删除重复项以使用相对单元格引用。

这行得通...

ActiveSheet.Range("B1:B31").RemoveDuplicates Columns:=1, Header:=xlNo

但将其更改为相对，因此我可以在列不起作用的情况下进行迭代。

我尝试将单元格传递到数组中，然后查找重复项，然后将这些值返回到新工作表但列位置相同。

非常感谢任何帮助！我今天大部分时间都在用头撞砖墙！

刘易斯

【问题讨论】：

请在问题中添加您更改为相对代码的代码，并说明问题所在。

标签： excel duplicates vba

【解决方案1】：

计算 Max 行数和列数，然后遍历列。

Sub Button1_Click()
    Dim Rws As Long, Col As Long, r As Range
    Set r = Range("A1")
    Rws = Cells.Find(what:="*", after:=r, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Col = Cells.Find(what:="*", after:=r, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    Application.DisplayAlerts = 0
    Application.ScreenUpdating = 0

    For x = 2 To Col
        Range(Cells(1, x), Cells(Rws, x)).RemoveDuplicates Columns:=1, Header:=xlNo
    Next x

End Sub

【讨论】：

【解决方案2】：

试试下面的代码。它查看有多少列并遍历它们。对于每一列，它会查看存在的行数，然后从该列中删除重复项。开头和结尾的 Application.ScreenUpdating 和 Application.Calculation 位应该有助于加快速度。

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Dim i As Long
Dim Ws1 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets("Name of the sheet your data is in")
Dim LastColumn As Long
Dim LastRow As Long

With Ws1
    LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
    For i = 1 To LastColumn
        LastRow = .Cells(.Rows.Count, i).End(xlUp).Row
        Range(.Cells(1, i), .Cells(LastRow, i)).RemoveDuplicates Columns:=1, Header:=xlNo
    Next i
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

【讨论】：

【解决方案3】：

当我在寻找一个独立于所用 Excel 版本的解决方案时（RemoveDuplicates 需要 Excel2013 或更高版本），我建议将范围复制到数组中，将唯一值收集到字典中，然后单独复制回唯一值：

Option Explicit

Sub UniqueCol()
    ' remove duplicate values from each column
    ' http://stackoverflow.com/questions/34471130/how-to-go-through-each-column-and-remove-duplicates-in-excel-vb
    ' 2015-12-26
    Dim Rng As Range, dst As Range
    Dim MyArray As Variant
    Dim dict As Object
    Dim values As Variant, el As Variant
    Dim col As Long, row As Long, ncols As Long, nrows As Long

    Set Rng = Range("C2:K40")
    nrows = Rng.Rows.Count
    ncols = Rng.Columns.Count

    Set dict = CreateObject("Scripting.Dictionary")

    For col = 1 To ncols
        MyArray = Rng.Columns(col)
        For row = 1 To nrows
            dict(MyArray(row, 1)) = True
        Next row
        values = dict.Keys()
        Rng.Columns(col).Clear
        Set dst = Rng.Columns(col).Cells(1, 1).Resize(UBound(values), 1)
        dst.Value = Application.Transpose(values)
        dict.RemoveAll
    Next col
End Sub

在这里，源范围被硬编码为 C2:K40。您将需要对 MS Scripting 对象的引用。

【讨论】：