返回列表 上一主題 發帖

VBA尋找重複

Sub test_01()
Dim Arr, xD, i&, T$, U&, TM
TM = Timer
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([C2], Cells(Rows.Count, 3).End(3))
For i = 1 To UBound(Arr)
    T = Arr(i, 1):  U = xD(T):  Arr(i, 1) = ""
    If U > 0 Then Arr(U, 1) = "重覆": xD(T) = -1: U = -1
    If U < 0 Then Arr(i, 1) = "重覆"
    If U = 0 Then xD(T) = i
Next i
[B2].Resize(UBound(Arr)) = Arr
MsgBox Timer - TM
End Sub

五萬多筆, 約一秒內可完成~~

TOP

回復 4# a5007185


如果用VBA, 非不得已才去用函數, 儘量避免,
一般的公式解, COUNTIF也是特別慢, 資料一多, 準卡檔!

TOP

Sub test_02()
Dim Arr, Brr, xD, i&, TM
TM = Timer
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([C2], Cells(Rows.Count, 3).End(3))
ReDim Brr(1 To UBound(Arr), 0)
For i = 1 To UBound(Arr)
    xD(Arr(i, 1) & "") = xD(Arr(i, 1) & "") + 1
Next i
For i = 1 To UBound(Arr)
    If xD(Arr(i, 1) & "") > 1 Then Brr(i, 0) = "重覆"
Next
[B2].Resize(UBound(Arr)) = Brr
MsgBox Timer - TM
End Sub

這是基本套路, 用了兩個迴圈, 慢一些些~~
xD(Arr(i, 1) & "")  加 "" 是為防止[純數字]在數值格式與文字格式不同而產生差異!

TOP

本帖最後由 准提部林 於 2018-9-28 10:04 編輯

回復 10# 千暉尋

U=xD(T) 先取出字典的ITEM值, 若T值還未丟進字典, U 值為0(或"")

U=0  表示尚未掃過的KEY, 先給值 i 保留後用 (相當于列號)
U>0  表示是第2次掃到的, 其ITEM值是上一次保留的"列號", 順勢將上一次的位置標示"重覆", 再將 ITEM 改成 -1
U<0  表示已掃過2次以上, 直接標示"重覆"

TOP

回復 14# Qin

只標示有重覆的[最後一個]

Sub test_03()
Dim Arr, xD, i&, T$, U&, TM
TM = Timer
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([C2], Cells(Rows.Count, 3).End(3))
For i = UBound(Arr) To 1 Step -1
    T = Arr(i, 1):  U = xD(T):  Arr(i, 1) = ""
    If U > 0 Then Arr(U, 1) = "Rept": xD(T) = -1
    If U = 0 Then xD(T) = i
Next i
[B2].Resize(UBound(Arr)) = Arr
MsgBox Timer - TM
End Sub

TOP

        靜思自在 : 有心就有福,有願就有力,自造福田,自得福緣。
返回列表 上一主題