- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2024-10-30
|
5#
發表於 2021-10-6 14:08
| 只看該作者
回復 4# oak0723-1
請測試看看，謝謝
Sub test()
Dim Arr, Drr, Brr(), Crr(), T, T1, T2
Tm = Timer
Arr = Range([資料庫!b6], [資料庫!b65536].End(3))
Drr = Sheets("資料庫").Range("i6:ama" & UBound(Arr) + 5)
[比對!b6].Resize(UBound(Arr)) = Arr
ReDim Brr(1 To UBound(Arr), 1 To 1000)
ReDim Crr(1 To UBound(Arr), 1 To 1)
With Sheets("比對")
Arr = .Range("i3:alt3")
For i = 1 To UBound(Drr)
Crr(i, 1) = 0
For j = 1 To UBound(Arr, 2)
T = Arr(1, j): T1 = Drr(i, j): T2 = Drr(i, j + 6)
If T = "" Or T1 = "" Then Brr(i, j) = "": GoTo 99
If T = T2 Then
Brr(i, j) = 1: Crr(i, 1) = Crr(i, 1) + 1
Else
Brr(i, j) = 0
End If
99: Next j
Next i
.Range("h6").Resize(UBound(Crr)) = Crr
.Range("i6").Resize(UBound(Brr), UBound(Brr, 2)) = Brr
End With
MsgBox Timer - Tm
End Sub |
|
