- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-5-5
|
13#
發表於 2023-11-14 15:04
| 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與邏輯值運算,學習方案如下,請各位前輩指教
Option Explicit
Sub TEST_1()
Dim Brr, Crr, Arr, v, i&, j%, R&, C%
Dim S1 As Worksheet, S2 As Worksheet
Set S1 = Sheets("資料庫"): Set S2 = Sheets("比對")
R = S1.Cells(Rows.Count, "B").End(xlUp).Row
C = S1.Cells(5, Columns.Count).End(xlToLeft).Column
Brr = Range(S1.Cells(R, "I"), S1.Cells(6, C))
Crr = Range(S2.[I3], S2.Cells(4, C))
ReDim Arr(1 To UBound(Brr), UBound(Brr, 2))
For j = 1 To UBound(Brr, 2)
If (Crr(1, j) <> "") * (Crr(2, j) <> "") = 0 Then GoTo j01
For i = 1 To UBound(Brr)
v = Brr(i, j)
If v = "" Then GoTo i01
Arr(i, j) = (v >= Crr(1, j)) * (v <= Crr(2, j))
Arr(i, 0) = Arr(i, 0) + Arr(i, j)
i01: Next
j01: Next
S2.[H6].Resize(UBound(Arr), UBound(Arr, 2) + 1) = Arr
S2.Range("B6:B" & R) = S1.Range("B6:B" & R).Value
Set S1 = Nothing: Set S2 = Nothing: Erase Brr, Crr, Arr
End Sub |
|
