Question

我希望浏览7776列数据并删除重复数据。

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

这有效......

ActiveSheet.Range（＆＃34; B1：B31＆＃34;）。RemoveDuplicates Columns：= 1，Header：= xlNo

但是将其更改为相对，所以我可以迭代，但列不起作用。

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

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

路易斯

Answer 1

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

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

Answer 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

Answer 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对象的引用。

如何浏览每一列并删除Excel中的重复项（VB）

3 个答案: