返回列表 上一主題 發帖

VBA尋找重複

回復 3# 准提部林


    謝謝前輩
後學藉此帖學習前輩的方案,方案學習心得註解如下,請前輩在指導

執行前:


執行結果:



Option Explicit
Sub test_01()
Dim Arr, xD, i&, T$, U&, TM
'↑宣告變數
TM = Timer
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD變數是 字典
Arr = Range([C2], Cells(Rows.Count, 3).End(3))
'↑令Arr變數是 二維陣列,以儲存格值帶入陣列中
For i = 1 To UBound(Arr)
'↑設順迴圈
    T = Arr(i, 1):  U = xD(T):  Arr(i, 1) = ""
    '↑令T變數是 Arr陣列值(關鍵字),
    '令U變數是 關鍵字查xD字典的item值
    '令清除掉Arr陣列裡的值

    If U > 0 Then Arr(U, 1) = "重覆": xD(T) = -1: U = -1
    '↑如果U變數大於0,代表此關鍵字在Arr陣列i列值還不是 "重覆",
    '也就是初次檢查到重覆!就令Arr陣列U變數列值是 "重覆"字串,
    '令此關鍵字的item改為-1,令U變數是 -1

    If U < 0 Then Arr(i, 1) = "重覆"
    '↑如果U變數小於0,代表Arr陣列這迴圈列值是重複的,
    '就令Arr陣列i迴圈列值是 "重覆"字串

    If U = 0 Then xD(T) = i
    '↑如果U變數是 0,代表此關鍵字是第1次出現,
    '只以此關鍵字當key,item是i迴圈數要納入xD字典裡就好

Next i
[B2].Resize(UBound(Arr)) = Arr
'↑令Arr陣列值從[B2]擴展的儲存格中寫入
MsgBox Timer - TM
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 君子立恆志,小人恆立志。
返回列表 上一主題