返回列表 上一主題 發帖

[發問] 將不同工作值匯在一個工作表內

[發問] 將不同工作值匯在一個工作表內

123.rar (28.12 KB) 各位先進這是一個值班統計表,平日係由A組人輪值,週六及其他例假日仍由A組人員輪值,星期日由B組人輪值,請問要如何將三個工作表的輪值狀況會整在一個工作表內呢,用函數是否可以達成

本帖最後由 GBKEE 於 2011-9-10 19:35 編輯

回復 1# h60327
For i = [K1] To [K1] + 730     超過一年會造成資料不正確     
建議 : 假日,平日 週日 要修改為 For i = [K1] To DateAdd("yyyy", 1, [k1]) - 1     且K1 是要同一天

總表B2:->  2011/09 XXXX    中間要空一格
  1. Sub Ex()
  2.     Dim 週表(), Ds As Object, 表單 As Range, R As Range
  3.     Dim Sh As Worksheet, f As Range, D As Date
  4.     週表 = Array("一", "二", "三", "四", "五", "六", "日")          '星期別之陣列
  5.     Set Ds = CreateObject("Scripting.Dictionary")
  6.     With Sheets("總表")                                             '指定在總表
  7.         Set 表單 = .[B5]                              '總表的第1個日期
  8.         D = DateValue(Split(.[B2], Space(1))(0))                    'B2:->  2011/09 XXXX
  9.         For Each Sh In Sheets
  10.             If Sh.Name <> .Name Then                                '依序在平日,假日,周日 等工作表
  11.                 For Each R In Sh.UsedRange.Columns(3).Cells         '第3欄
  12.                     If R = Month(D) Then Ds(DateSerial(Year(D), R, R.Cells(1, 2))) = R.Cells(1, -1)  'R.Cells(1, -1): ->當日值班人員
  13.                     'R = Month(D)   同一月份
  14.                 Next
  15.             End If
  16.         Next
  17.         表單.Resize(31, 14) = ""      '清除舊資料
  18.         Do While Month(D) = Month(DateValue(Split(.[B2], Space(1))(0)))    '迴圈的條件是同一月份
  19.             Set f = .Cells.Find(Ds(D))                                     '尋找當日在表單裡值班人員的位置
  20.             .Cells(表單.Row, f.Column) = "●"                              'f.Column: 值班人員位置的欄數
  21.             With 表單
  22.                 .Cells = Day(D)                                            '寫入 日數
  23.                 .Cells(1, 2) = 週表(Weekday(D, vbMonday) - 1)               '寫入傳回星期別
  24.                 .Resize(, 2).Interior.ColorIndex = IIf(Weekday(D, vbMonday) >= 6, 6, xlNone) '制訂休假日背景色
  25.             End With
  26.             Set 表單 = 表單.Offset(1)                                       '往下位移一位
  27.             D = D + 1                                                       '日期+1天
  28.         Loop
  29.     End With
  30.     Set Ds = Nothing
  31.     Set 表單 = Nothing
  32.      Set R = Nothing
  33.      Set Sh = Nothing
  34. End Sub
複製代碼

TOP

回復 1# h60327

函數完成請見附件
123.rar (22.41 KB)
學海無涯_不恥下問

TOP

樞鈕也很方便呀。
2011-09-11_002659.jpg
2011-9-11 00:26

TOP

由於權限還無法下載,請問Hsieh板大函數公式為何呢?再次感謝各位先進的指教

TOP

        靜思自在 : 對父母要知恩,感恩、報恩。
返回列表 上一主題