請高手幫忙解答,謝謝

brabus

王老六餐廳人員名單，組別，職稱，姓名，職等在A5~D32淺藍色區域
因輪班的關係，出勤可能有不同的組合出勤，但一定都是一組一組一起到職，每組的人數不一定，至於一天有幾組是不一定的，C35~C39中的下拉選單是可以選擇今日出勤與否的控制選項
現在想在黃色區域連續呈現今天到勤的小組名單，請問要如何完成??名單要按組別大小排列由小到大，像範例L:N是如果是2和5組到勤的呈現，P:R是3,4組到勤的呈現，以此類推。
我現在的作法是:如果C35=是，則E5~G8會呈現，以此類推，但無法讓它連續不間斷排列到黃色區域，要如何完成，請高手指點一下，謝謝
範例在附件，如果有說的不清楚的再請發問,謝謝＿
活頁簿1.rar (11.71 KB)

下載次數: 9

2020-12-23 21:22

hcm19522

https://blog.xuite.net/hcm19522/twblog/589525246

准提部林

H5//陣列公式(三鍵完成)
=iferror(INDEX(B:B,SMALL(IF(1-ISNA(MATCH(LOOKUP(ROW($5:$32),ROW($5:$32)/($A$5:$A$32<>""),$A$5:$A$32)&"是",$B$35:$B$39&$C$35:$C$39,)),ROW($5:$32)),ROW(A1))),"")

brabus

回復 2# hcm19522
謝謝H大及准大的回復
再請問如果連第幾組都要呈現的話，是否可能??感覺牽涉到儲存格合併的問題好像不可能對不對???

准提部林

回復 4# brabus

陣列公式//右拉四格/下拉
=iferror(INDEX(A:A,SMALL(IF(VLOOKUP(T(IF({1},LOOKUP(ROW($5:$32),ROW($5:$32)/($A$5:$A$32<>""),$A$5:$A$32))),$B$35:$C$39,2,)="是",ROW($5:$32)),ROW(A1)))&"","")

1) 只能取出第一個"第?組"
2) &"" 會變成純文字格式, "職等"的數字也是文字格式,
   若不想數值變文字格式, 可以刪除這個, 但儲存格格式須設定為"#"...即0值不顯示

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行前:                                                       執行結果:

下載 (104.34 KB)

2023-12-27 09:58

   

下載 (116.09 KB)

2023-12-27 09:59

Option Explicit
Sub TEST()
Dim Brr, Z, i&, j%, sR As Range, eR As Range, xR As Range
With ActiveSheet.UsedRange
   Intersect(.Offset(0, 7), .Offset(4, 0)).Delete Shift:=xlUp
End With
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([A1], [C5].End(xlDown)(2, 2))
For i = 1 To UBound(Brr)
   If Trim(Brr(i, 1)) <> "" Or i = UBound(Brr) Then
      Set sR = eR: Set eR = Cells(i, 1)
      If Not sR Is Nothing Then
         Z(sR & "") = Range(sR(1, 2), eR(0, 4))
         Z(sR & "/r") = eR.Row - sR.Row
      End If
   End If
Next
Brr = Range([C35], [B65536].End(xlUp)): Set xR = [H5]
For i = 1 To UBound(Brr)
   If Brr(i, 2) = "是" Then
      With xR.Resize(Z(Brr(i, 1) & "/r"), 3)
         .Value = Z(Brr(i, 1))
         .Rows(1).Font.Bold = True
         For j = 7 To 10: .Borders(j).Weight = 4: Next
      End With
      Set xR = xR(Z(Brr(i, 1) & "/r") + 1, 1)
   End If
Next
End Sub
'==========================================================
以下是組別也帶入的方案
執行前:                                                           執行結果:

下載 (113.38 KB)

2023-12-27 10:31

   

下載 (125.82 KB)

2023-12-27 10:32

Option Explicit
Sub TEST()
Dim 資料陣列, 到勤控制陣列, 字典, i&, j%, 起始格 As Range, 結束格 As Range, 結果起始格 As Range
With ActiveSheet.UsedRange
   Intersect(.Offset(0, 7), .Offset(4, 0)).Delete Shift:=xlUp
End With
Set 字典 = CreateObject("Scripting.Dictionary")
資料陣列 = Range([A1], [C5].End(xlDown)(2, 2))
For i = 1 To UBound(資料陣列)
   If Trim(資料陣列(i, 1)) <> "" Or i = UBound(資料陣列) Then
      Set 起始格 = 結束格: Set 結束格 = Cells(i, 1)
      If Not 起始格 Is Nothing Then
         字典(起始格 & "") = Range(起始格(1, 1), 結束格(0, 4))
         字典(起始格 & "/r") = 結束格.Row - 起始格.Row
      End If
   End If
Next
到勤控制陣列 = Range([C35], [B65536].End(xlUp)): Set 結果起始格 = [H5]
For i = 1 To UBound(到勤控制陣列)
   If 到勤控制陣列(i, 2) = "是" Then
      With 結果起始格.Resize(字典(到勤控制陣列(i, 1) & "/r"), 4)
         .Value = 字典(到勤控制陣列(i, 1))
         .Rows(1).Font.Bold = True
         .Columns(1).Merge
         For j = 7 To 10: .Borders(j).Weight = 4: Next
      End With
      Set 結果起始格 = 結果起始格(字典(到勤控制陣列(i, 1) & "/r") + 1, 1)
   End If
Next
End Sub

hcm19522

(輸入編號12192) google網址:https://hcm19522.blogspot.com/