返回列表 上一主題 發帖

VBA尋找重複

本帖最後由 jackyq 於 2018-9-28 08:40 編輯

回復 10# 千暉尋

你看不懂是因為多了2段藍字跳板 , 跳板內又存在著 U 在 -1, 列位置 二值之間來回交替切換

你可以把跳板移除 , 等效如下

    Sub test_01a()
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(i, 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

本帖最後由 准提部林 於 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

回復  千暉尋

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

U=0  表示尚未掃過的 ...
准提部林 發表於 2018-9-28 10:01

謝謝準大的說明,簡明扼要,我曾試過,第1次出現U值都是0 ,想不通為何,還在鑽牛角尖想說0到底是KEY值還是ITEM值,原來兩者都不是,是根本還沒寫入,一語警醒夢中人!

TOP

回復 12# 准提部林


    尋找同一欄重覆資料       
       
(只顯示多個重覆中的其中的1個)

Rept.rar (54.61 KB)

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

回復 15# 准提部林

這是原本想要的搜尋結果, 但自己發錯的問題...
無論如何, 謝謝准大..

Rept                code
                40000001
Rept                40000001
                40000002
Rept                40000002
                40000003
                40000004
Rept                40000004
                40000005
Rept                40000005
                40000006
Rept                40000006
Rept                40000006
Rept                40000006

Sub test_04()
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: U = -0
    If U = 0 Then xD(T) = i
Next i
[B2].Resize(UBound(Arr)) = Arr
MsgBox Timer - TM
End Sub

TOP

回復 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

        靜思自在 : 每天無所事事,是人生的消費者,積極、有用才是人生的創造者。
返回列表 上一主題