- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2026-5-26
|
回復 4# ssooi
我也覺得 luhpro 大大的程式應該可以用,所以我的程式如下,請在確認,謝謝。
Sub test()
Dim Arr, xD, N&, i&, j&, T$
Arr = Range([A1], [C65536].End(xlUp))
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
T = Arr(i, 1) & "_" & Arr(i, 3)
xD(T) = xD(T) + 1
Next
For i = 2 To UBound(Arr)
T = Arr(i, 1) & "_" & Arr(i, 3)
If xD(T) > 1 Then GoTo 100
N = N + 1
For j = 1 To 3: Arr(N + 1, j) = Arr(i, j): Next
100: Next
If N > 0 Then [E1].Resize(N + 1, 3) = Arr
End Sub |
|