返回列表 上一主題 發帖

想找出與前一列重複的數字

准提部林

帖子
2839 
主題
10 
精華
0 
積分
2895 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-2-15 
1# 跳轉到 »
發表於 2021-6-6 12:09 | 顯示全部帖子
P欄設為文字格式~~

Sub TEST_A01()
Dim Arr, xD, i&, j%, T$, TT$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([m1], [a65536].End(xlUp))
For i = 1 To UBound(Arr)
For j = 1 To UBound(Arr, 2)
    T = Arr(i, j): xD(T & "/" & i) = 1
    If xD(T & "/" & i - 1) = 1 Then TT = TT & "," & T
Next j
    Arr(i, 1) = Mid(TT, 2): TT = ""
Next i
[p1].Resize(UBound(Arr)) = Arr
End Sub


'==============================

TOP

准提部林

帖子
2839 
主題
10 
精華
0 
積分
2895 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-2-15 
2#
發表於 2021-6-6 12:39 | 顯示全部帖子
字典隨取隨消, 減少佔用資源~~

Sub TEST_A02()
Dim Arr, Brr, xD, i&, j%, TT$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([m1], [a65536].End(xlUp))
ReDim Brr(1 To UBound(Arr), 0)
For i = 2 To UBound(Arr)
    For j = 1 To UBound(Arr, 2)
        xD(Arr(i - 1, j) & "") = 1
    Next j
    For j = 1 To UBound(Arr, 2)
        If xD(Arr(i, j) & "") = 1 Then TT = TT & "," & Arr(i, j)
    Next j
    Brr(i, 0) = Mid(TT, 2): TT = "": xD.RemoveAll
Next i
[p1].Resize(UBound(Brr)) = Brr
End Sub


.==============================

TOP

准提部林

帖子
2839 
主題
10 
精華
0 
積分
2895 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-2-15 
3#
發表於 2021-6-7 13:02 | 顯示全部帖子
回復 14# samwang


12F

讓字典的key夾帶 i 值
當 i=1 時
將 xd(T & "/" & 1)=1 加入字典,
同時檢查 xd(T & "/" &  0) 是否在字典中, 因是第1行, 所以都為"空值",

當 i=2 時
將 xd(T & "/" & 2)=1 加入字典,
同時檢查 xd(T & "/" &  1) 是否在字典中, 因是第2行, 只要字典key帶1的, 即是上下行相同

類推~~
這方法讓所有數字都因行號不同而全部納入字典, 各自成為獨立的key值,
缺點: 字典會放太多資料

TOP

        靜思自在 : 人事的艱難與琢磨，就是一種考驗。
返回列表 上一主題