|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub TEST_A1()
Dim Arr, Brr, xD, i&, T$, k%, N&(1), m&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range("a1").CurrentRegion
For i = 2 To UBound(Arr)
xD(Arr(i, 1) & "+" & Arr(i, 2) & "+" & Arr(i, 3)) = 2 + (Arr(i, 4) = "NG")
Next i
Arr = Range("f1").CurrentRegion
ReDim Brr(1 To UBound(Arr), 1)
For i = 2 To UBound(Arr)
T = Arr(i, 4) & "+" & Arr(i, 5) & "+" & Arr(i, 8)
k = xD(T): If k > 1 Then GoTo i01
N(k) = N(k) + 1: If N(k) > m Then m = N(k)
Brr(N(k), 1 - k) = T
i01: Next i
[p1].Resize(m, 2) = Brr
End Sub
|
评分
-
2
查看全部评分
-
|