- 帖子
- 1567
- 主題
- 40
- 精華
- 0
- 積分
- 1591
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2026-2-2
|
6#
發表於 2022-12-23 16:47
| 只看該作者
回復 2# Andy2483
複習了一下,心得註解,請前輩們指導
Option Explicit
Sub 符合多條件帶出相關資訊_20221221_1()
Dim Arr(4), Brr, Crr, Da, Y, T, We
Dim Sh As Worksheet, i&, N&, j%
'↑宣告變數:Arr是一維陣列,從Arr(0)~Arr(4),(Brr,Crr,Da,Y,T,We)是通用型變數,
'Sh是工作表變數,(i, N)是長整數,j是短整數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y是 字典
Set Sh = ActiveSheet
'↑令Sh工作表變數是 現用工作表(現表)
Brr = Range(Sh.[A1], Sh.UsedRange)
'↑令Brr是 二維陣列!以現表[A1]到 現表裡有使用格,這範圍儲存格值倒入
Da = InputBox("請輸入 日期!", "符合多條件帶出相關資訊", Date)
'↑令Da這通用型變數是InputBox()函式回傳值
If Not IsDate(Da) Then Exit Sub
'↑如果以IsDate()函式判斷Da變數不是日期!結束程序執行
We = Right(Format(Da, "aaaa"), 1)
'↑令We這通用型變數是 Da變數用Format()轉化為文字(星期?),再用Right()取出最右邊的字
T = Array(5, 1, 2, 3, 4)
'↑令T這通用型變數是一維陣列,倒入5個數字
For i = 2 To UBound(Brr)
'↑設順迴圈!i從2到 Brr陣列縱向最大索引列號數
If Trim(Brr(i, 3)) = "" Then Exit For
'↑如果i迴圈第3欄Brr陣列值經過去頭尾空白字元後是 空字元!就結束程序執行
If InStr(Brr(i, 3), We) Then
'↑如果i迴圈第3欄Brr陣列值裡有包含We這字串變數??
If N = 0 Then
'↑如果N這長整數變數是初始值 0??
Crr = Arr
'↑令Crr是 Arr這個空陣列
For j = 0 To UBound(T)
'↑設順迴圈!令j從0跑到 T陣列的最後一個索引號碼
Crr(j) = Brr(1, T(j))
'↑令j迴圈Crr陣列值是 第1列第(j迴圈數指向T陣列值)欄的Brr陣列值
Next
N = N + 1
'↑令N變數累加 1
Y(N) = Crr
'↑令以N變數為key,item是Crr陣列,倒入Y字典中
End If
N = N + 1
'↑令N變數累加 1
Crr = Arr
'↑令Crr是 Arr這個空陣列
For j = 0 To UBound(T)
'↑設順迴圈!令j從0跑到 T陣列的最後一個索引號碼
Crr(j) = Brr(i, T(j))
'↑令j迴圈Crr陣列值是 第i迴圈列第(j迴圈數指向T陣列值)欄的Brr陣列值
Next
Y(N) = Crr
'↑令以N變數為key,item是Crr陣列,倒入Y字典中
End If
Next
If N = 0 Then Exit Sub
'↑如果N變數是 0,就結束程序執行
Workbooks.Add
'↑令程序產生一個新活頁簿
[A2].Resize(N, UBound(Arr) + 1) = Application.Transpose(Application.Transpose(Y.ITEMS))
'↑令這新活頁簿從[A2]擴展縱向N變數列,橫向Arr陣列橫向最大索引欄號數+1欄,這範圍儲存格的值,
'以Y字典的item 轉置兩次,倒入這擴展的範圍儲存格中
Range([A1], ActiveSheet.UsedRange).Borders.LineStyle = 1
'↑令有使用的儲存格格線是 細實線
Cells.Columns.AutoFit
'↑令所有儲存格欄寬自動調整
[2:2].Font.Bold = True
'↑令第2列的字體是粗體
[A1].NumberFormatLocal = "m""月""d""日"";@"
'↑令[A1]的格式是?月?日
[A1] = Da: [B1] = We
'↑令[A1]值是 Da變:[B1]值是 We變數
Set Y = Nothing
Set Brr = Nothing
Erase Crr, Arr
'↑釋放變數
End Sub
祝各位前輩 佳節快樂 |
|
