【VBA案例006】数据去重

程技 VBA

发布时间 : 2023-10-23 00:00

字数:345 阅读 :

方法一：
方法二：
方法二：扩展

大家好！你是否在为数据去重感到烦恼？

今天，我们将分享两种高效的 VBA 方法，帮助你轻松应对数据去重难题。

举个例子。

我们要对以下数据的产品和型号进行数据去重，保留唯一值。

以下是VBA代码，你也可以直接观看下方的视频解析：

方法一：

1
2
3

Sub 方法一()
    Range("f1:h18").RemoveDuplicates Array(1, 2), xlYes
End Sub

方法二：

Sub 方法二第一次出现的值()
    Dim i, j, k
    Dim ar, br()

    ar = Range("a1:c18")
    ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))

    Dim d As Object, kw$
    Set d = CreateObject("Scripting.Dictionary")
    'd.CompareMode = vbTextCompare '不区分大小写

    For i = 1 To UBound(ar)
        kw = ar(i, 1) & ar(i, 2)
        If Not d.exists(kw) Then
            k = k + 1
            For j = 1 To UBound(br, 2)
                br(k, j) = ar(i, j)
            Next j
            d(kw) = ""
        End If
    Next i

    [f1].Resize(k, UBound(br, 2)) = br

End Sub

方法二：扩展

Sub 方法二最后值()
    Dim i, j, k
    Dim ar, br()

    ar = Range("a1:c18")
    ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))

    Dim d As Object, kw$
    Set d = CreateObject("Scripting.Dictionary")
    'd.CompareMode = vbTextCompare '不区分大小写

    For i = 1 To UBound(ar)
        kw = ar(i, 1) & ar(i, 2)
        d(kw) = i
    Next i

    Dim dickey
    For Each dickey In d.keys
        k = k + 1
        For j = 1 To UBound(br, 2)
            br(k, j) = ar(d(dickey), j)
        Next j
    Next

    [f1].Resize(k, UBound(br, 2)) = br

End Sub

原始链接

转载请注明来源，欢迎对文章中的引用来源进行考证，欢迎指出任何有错误或不够清晰的表达。可以在下面评论区评论，也可以邮件至 richffan@outlook.com