- 帖子
- 2798
- 主題
- 10
- 精華
- 0
- 積分
- 2854
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-4-15
|
6#
發表於 2018-10-31 15:45
| 只看該作者
回復 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
 Xl0000235(匯入).rar (18.51 KB)
|
|
發表於 2018-10-30 11:39
| 
