[發問] 符合多條件帶出相關資訊

　暱稱: 厚臉皮的學生

帖子: 1527
主題: 40
精華: 0
積分: 1551
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2025-11-4

2^#

發表於 2022-12-21 15:21 | 只看該作者

本帖最後由 Andy2483 於 2022-12-21 15:25 編輯

回復 1# 013160

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

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

按確定後:

輸入: 12/22

輸入: 12/23

程式碼如下:

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2843
主題: 10
精華: 0
積分: 2899
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2025-10-18

3^#

發表於 2022-12-21 19:28 | 只看該作者

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

A15//陣列公式(三鍵同按)
=iferror(INDEX($A:$E,SMALL(IF(1-ISERR(0/(FIND($B$13,"/"&$C$2:$C$9)-1)),ROW($2:$9)),ROW(A1)),MATCH(A$14,$1:$1,))&"","")
右拉//下拉

　暱稱: 厚臉皮的學生

帖子: 1527
主題: 40
精華: 0
積分: 1551
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2025-11-4

4^#

發表於 2022-12-23 13:46 | 只看該作者

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1527
主題: 40
精華: 0
積分: 1551
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2025-11-4

5^#

發表於 2022-12-23 15:43 | 只看該作者

本帖最後由 Andy2483 於 2022-12-23 15:49 編輯

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

=SMALL(A2:A10,4)

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1527
主題: 40
精華: 0
積分: 1551
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2025-11-4

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

祝各位前輩佳節快樂

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流