Option Explicit
Sub TEST()
Dim Brr, Y, R&, i&, j%, V$
'↑宣告變數
Brr = Range([Data!M1], [Data!A65536].End(3))
'↑令Brr變數是 二維陣列,以Data表A~M欄儲存格值帶入陣列中
V = [Result!A1]
'↑令V變數是 Result表[A1]儲存格字串
For i = 2 To UBound(Brr)
'↑設順迴圈
If Brr(i, 4) = V Then
'↑如果第4欄值是 同V變數
R = R + 1: Brr(R, 1) = i
'↑令R變數累加1,令Brr陣列第1欄複寫入i變數值
For j = 1 To 12: Brr(R, j + 1) = Brr(i, j): Next
'↑令其他資料複寫入Brr陣列2~13欄
End If
Next
With Sheets("Result")
'↑以下是關於Result表的程序
.UsedRange.Offset(2, 0).ClearContents
'↑令標題列留下,其餘儲存格清除內容
.[A3].Resize(R, 13) = Brr
'↑令Brr陣列值寫入儲存格裡,超過範圍的陣列值忽略
End With
Set Y = Nothing: Erase Brr
'↑令釋放變數
End Sub
發表於 2023-5-26 13:34
| 
