Andy2483

回復 1# 013160


    謝謝前輩發表此主題與範例檔案
後學藉此主題學習到很多知識,但不知是否符合前輩情境需求,請試試看

輸入窗: 預先置入今天日期

下載 (159.14 KB)

2022-12-21 15:16

按確定後:

下載 (73.65 KB)

2022-12-21 15:19

輸入: 12/22

下載 (22.34 KB)

2022-12-21 15:19

輸入: 12/23

下載 (67.11 KB)

2022-12-21 15:20

程式碼如下:

Option Explicit
Sub 符合多條件帶出相關資訊_20221221_1()
Dim Arr(4), Brr, Crr, i&, Y, T
Dim Sh As Worksheet, Da, N&, j%, We
Set Y = CreateObject("Scripting.Dictionary")
Set Sh = ActiveSheet
Brr = Range(Sh.[A1], Sh.UsedRange)
Da = InputBox("請輸入 日期!", "符合多條件帶出相關資訊", Date)
If Not IsDate(Da) Then Exit Sub
We = Right(Format(Da, "aaaa"), 1)
T = Array(5, 1, 2, 3, 4)
For i = 2 To UBound(Brr)
   If Trim(Brr(i, 3)) = "" Then Exit For
   If InStr(Brr(i, 3), We) Then
      If N = 0 Then
         Crr = Arr
         For j = 0 To UBound(T)
            Crr(j) = Brr(1, T(j))
         Next
         N = N + 1
         Y(N) = Crr
      End If
      N = N + 1
      Crr = Arr
      For j = 0 To UBound(T)
         Crr(j) = Brr(i, T(j))
      Next
      Y(N) = Crr
   End If
Next
If N = 0 Then Exit Sub
Workbooks.Add
[A2].Resize(N, UBound(Arr) + 1) = Application.Transpose(Application.Transpose(Y.ITEMS))
Range([A1], ActiveSheet.UsedRange).Borders.LineStyle = 1
Cells.Columns.AutoFit
[2:2].Font.Bold = True
[A1].NumberFormatLocal = "m""月""d""日"";@"
[A1] = Da: [B1] = We
Set Y = Nothing
Set Brr = Nothing
Erase Crr, Arr
End Sub

Andy2483

回復 3# 准提部林


    謝謝前輩指導
B13//
=RIGHT(TEXT(A13,"aaa"))  A13輸入日期, 自動變換星期

1.將[A13]值轉換為週二,再取其最右邊的第1個字顯示在[B13]此儲存格
1.1.TEXT(): 以格式代碼來套用格式，藉此變更數字顯示的方式
=TEXT(A13,"aaa")→  週二
https://support.microsoft.com/zh-tw/office/text-%E5%87%BD%E6%95%B8-20d5ac4d-7b94-49fd-bb38-93d29371225c

1.2.=RIGHT("週二")→  二
完整方式 =RIGHT("週二",1) 如果省略 1，則會假設其值為 1
https://support.microsoft.com/zh-tw/office/right-rightb-%E5%87%BD%E6%95%B8-240267ee-9afa-4639-a02b-f19e1786cf2f

Andy2483

謝謝論壇,謝謝各位前輩
很難

下載 (261.26 KB)

2022-12-23 15:42

=SMALL(A2:A10,4)

下載 (53.36 KB)

2022-12-23 15:49

Andy2483

回復 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

祝各位前輩 佳節快樂