Board logo

標題: [發問] 符合多條件帶出相關資訊 [打印本頁]

作者: 013160    時間: 2022-12-21 00:14     標題: 符合多條件帶出相關資訊

請教各位大大:
如何只輸入星期後可自動帶出所有資料或輸入星期及客戶簡稱可帶出相關資料。
[attach]35633[/attach]
[attach]35634[/attach]
作者: Andy2483    時間: 2022-12-21 15:21

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

回復 1# 013160


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

輸入窗: 預先置入今天日期
[attach]35635[/attach]

按確定後:
[attach]35636[/attach]

輸入: 12/22
[attach]35637[/attach]

輸入: 12/23
[attach]35638[/attach]

程式碼如下:

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
作者: 准提部林    時間: 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,))&"","")
右拉//下拉
作者: Andy2483    時間: 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
作者: Andy2483    時間: 2022-12-23 15:43

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

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

[attach]35648[/attach]

=SMALL(A2:A10,4)
[attach]35649[/attach]
作者: Andy2483    時間: 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

祝各位前輩 佳節快樂
作者: 013160    時間: 2022-12-28 22:08

回復  Andy2483


    複習了一下,心得註解,請前輩們指導
Option Explicit
Sub 符合多條件帶出相關資 ...
Andy2483 發表於 2022-12-23 16:47



    謝謝指教,受益了。
作者: 013160    時間: 2022-12-28 22:11

回復  013160


    謝謝前輩發表此主題與範例檔案
後學藉此主題學習到很多知識,但不知是否符合前輩情 ...
Andy2483 發表於 2022-12-21 15:21



   跟我想要的有點差距,但有七八成符合,謝謝指教!!
作者: 013160    時間: 2022-12-28 22:14

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

A15//陣列公式(三鍵同按)
=iferror(INDE ...
准提部林 發表於 2022-12-21 19:28



    感謝您的指點。
作者: hcm19522    時間: 2022-12-31 11:07

https://blog.xuite.net/hcm19522/twblog/590674699
作者: 013160    時間: 2023-1-4 22:59

hcm19522 發表於 2022-12-31 11:07



   請問是否可以讓提取的資料順序固定不變
作者: 013160    時間: 2023-1-5 02:45

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

A15//陣列公式(三鍵同按)
=iferror(INDE ...
准提部林 發表於 2022-12-21 19:28


前輩可以幫忙說明"A15//陣列公式(三鍵同按)"此公式嗎?
初學者看不太懂公式用法。
作者: hcm19522    時間: 2023-1-5 09:36

回復 11# 013160


    試試{=INDEX(A:A,SMALL(IF(1-ISERR(FIND($H$2,$F$2:$F$9)),ROW($2:$9),99),ROW(A1)))&""




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)