- 帖子
- 2848
- 主題
- 10
- 精華
- 0
- 積分
- 2903
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2026-7-25
|
回復 6# PKKO
〔雙重比對〕取出對應值:- Sub TEST_Vlookup()
- Dim TM, Arr, Brr, Crr, Xrr, xRow&, xD, i&
- TM = Timer: [B:B,E:E].Clear: [M1] = ""
- xRow = 20000
- Arr = [A1].Resize(xRow)
- Brr = [C1:D1].Resize(xRow)
- Crr = [F1:G1].Resize(xRow)
-
- Set xD = CreateObject("Scripting.Dictionary")
- For i = 1 To UBound(Crr)
- xD(Crr(i, 1)) = Crr(i, 2)
- Next
-
- Xrr = [E1].Resize(xRow) '(X1)
- For i = 1 To UBound(Brr)
- If xD.Exists(Brr(i, 2)) Then
- xD(Brr(i, 1)) = xD(Brr(i, 2))
- Xrr(i, 1) = xD(Brr(i, 2)) '(X2)
- End If
- Next
- [E1].Resize(xRow) = Xrr '(X3)
-
- Xrr = [B1].Resize(xRow)
- For i = 1 To UBound(Arr)
- If xD.Exists(Arr(i, 1)) Then Xrr(i, 1) = xD(Arr(i, 1))
- Next
- [B1].Resize(xRow) = Xrr
-
- [M1] = Timer - TM
- End Sub
複製代碼 (X1)(X2)(X3)這三行用來填入E欄做檢查用,可以刪除:
Test20150904v2.rar (689.08 KB)
EXCEL及VBA,只是插花非專業,大概寫寫,參考即可∼∼
|
|