【VBA案例006】数据去重

归档779

审技265 程技242 投技146 财技57 税技47 法技11 食技7 书技4

313 字

2 分钟

【VBA案例006】数据去重

2023-10-23

程技

VBA

浏览量加载中...

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

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

举个例子。

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

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

方法一：#

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

方法二：#

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

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

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

12
    For i = 1 To UBound(ar)
13
        kw = ar(i, 1) & ar(i, 2)
14
        If Not d.exists(kw) Then
15
            k = k + 1
16
            For j = 1 To UBound(br, 2)
17
                br(k, j) = ar(i, j)
18
            Next j
19
            d(kw) = ""
20
        End If
21
    Next i
22

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

25
End Sub

方法二：扩展#

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

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

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

12
    For i = 1 To UBound(ar)
13
        kw = ar(i, 1) & ar(i, 2)
14
        d(kw) = i
15
    Next i
16

17
    Dim dickey
18
    For Each dickey In d.keys
19
        k = k + 1
20
        For j = 1 To UBound(br, 2)
21
            br(k, j) = ar(d(dickey), j)
22
        Next j
23
    Next
24

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

27
End Sub