回復 5#s7659109
Sub 匯入()
Dim Arr, Brr, xD, r&, i&, j%, T$, xU As Range, N&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([匯總!C1], [匯總!A65536].End(xlUp))
For i = 2 To UBound(Arr)
xD(Arr(i, 1) & Arr(i, 2) & Arr(i, 3)) = 1
Next i
Application.ScreenUpdating = False
With Sheets("data")
.Unprotect
.[A:K].Locked = False
Set xU = .[A1:K1]
r = .[A65536].End(xlUp).Row
Arr = .Range("A1:J" & r)
Brr = .Range("K1:K" & r)
For i = 2 To r
If Val(xD(Arr(i, 1) & Arr(i, 2) & Arr(i, 3))) <> 1 Then
N = N + 1
For j = 1 To 10: Arr(N, j) = Arr(i, j): Next
End If
Brr(i, 1) = "v"
Set xU = Union(xU, .Cells(i, 1).Resize(1, 11))
Next i
.[K1].Resize(r) = Brr
xU.Locked = True
.EnableAutoFilter = True
.Protect Contents:=True, UserInterfaceOnly:=True
End With
If N = 0 Then Exit Sub
[匯總!B:B].NumberFormatLocal = "@"
[匯總!A65536].End(xlUp)(2).Resize(N, 10) = Arr
End Sub
