- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
46#
發表於 2013-11-30 11:15
| 只看該作者
回復 45# prince0413
依11月的檔案.的程式碼- Option Explicit
- Sub Ex()
- Dim Rng(1 To 4) As Range, i As Integer, ii As Integer, 出勤 As String, 日期 As Variant, Print_x As Integer
- Dim 出勤單 As Range, E As Range, Sh As Worksheet, 出勤班別()
- Set 出勤單 = Sheets("假日出勤單").Range("B3,D3,A5,B5,D5") '第1張出勤單要導入資料的位置
- Set Rng(1) = Sheets("假日出勤單").Range("J2") '設定社員 英文,中文,編號
- For i = 0 To 3 '出勤單: 第1張到 第4張的位置 間格 14 列
- 出勤單.Offset(i * 14) = "" '清除 資料
- Next
- Print_x = 0 '印列 A4紙張 的變數
- Set Sh = Sheets("11月") '***在指定月份****
- Set Rng(4) = Sh.Cells.Find("※本月假日出勤時段", lookat:=xlWhole)
- Set Rng(4) = Sh.Range(Rng(4).Offset(2), Rng(4).Offset(2).End(xlDown)) '出勤時間
- 出勤班別 = Application.WorksheetFunction.Transpose(Rng(4).Offset(, 5).Value) '早.晚...
-
- Do While Rng(1) <> "" '執行迴圈的條件: 社員<>""
- '※※※※※※※※※※※※※※每月需修改※※※※※※※※※※※※※※※
- With Sh
- '※※※※※※※※※※※※※※每月需修改※※※※※※※※※※※※※※※
- Set Rng(3) = Nothing '物件: 釋放
- Set Rng(2) = Sheets("中英文姓名對照表").Range("A:C").Find(Rng(1), lookat:=xlWhole)
- '英文,中文,編號:裡搜尋
- If Not Rng(2) Is Nothing Then
- Set Rng(2) = Rng(2).Parent.Range("A" & Rng(2).Row) '英文,中文,編號的第一欄 (英文)
- For i = 1 To 3 '如社員為中文 Sheets("11月")沒有 中文
- Set Rng(3) = Sh.Range("A:B").Find(Rng(2).Cells(i), lookat:=xlWhole)
- If Not Rng(3) Is Nothing Then Exit For '找到 英文 或 編號
- Next
- End If
- If Not Rng(3) Is Nothing Then
- i = 3 '第3欄 :C
- Do While IsNumeric(.Cells(4, i)) '執行迴圈的條件:第4列是數字
- If (.Cells(5, i) = "六" Or .Cells(5, i) = "日") And Not IsError(Application.Match(.Cells(Rng(3).Row, i), 出勤班別, 0)) Then
- 'Not IsError(Application.Match(.Cells(Rng(3).Row, i), 出勤班別, 0)) -> '假日班別是在[出勤班別]中
- 出勤 = "" '歸零
- For Each E In Rng(4) '本月假日出勤時段
- 日期 = Split(E.Offset(, 1), "/")(1) '刪掉月份
- 日期 = Split(日期, ".") '取得日期
- If Not IsError(Application.Match(.Cells(4, i), 日期, 0)) Then '尋找日期
- 出勤 = E
- Exit For
- End If
- Next
- If 出勤 <> "" Then '預防沒有 [全日,早,晚]的班別
- Set 日期 = .Cells(4, i)
- Print_x = IIf(Print_x = 4, 1, Print_x + 1)
- With 出勤單.Offset((Print_x - 1) * 14) '第 Print_x 的位置
- .Range("A1") = Rng(2).Offset(, 1) '社員中文
- .Range("C1") = Rng(2).Offset(, 2) '社員編號
- .Cells(3, 0) = DateSerial(2013, 11, 日期) '日期
- .Range("A3") = 出勤 '時間
- .Range("C3") = IIf(日期.Offset(1) = "六", "(星期六)", "(星期日)") & "沙龍營業"
- End With
- If Print_x = 4 Then '滿4筆印列
- 出勤單.Parent.PrintOut '印列出勤單
- For ii = 0 To 3
- 出勤單.Offset(ii * 14) = "" '清空已印列資料
- Next
- End If
- End If
- End If
- i = i + 1
- Loop
- End If
- Rng(1).Offset(, 1) = IIf(Rng(3) Is Nothing, "請檢查 : 假日出勤單 , 對照表 找不到 ", "")
- End With
- Set Rng(1) = Rng(1).Offset(1) '下一位姓名
- Loop
- If Print_x > 0 And Print_x <= 3 Then 出勤單.Parent.PrintOut 1, Application.Round(Print_x / 2, 0) ' 未滿 4 筆的資料沒印列
- End Sub
|
|
發表於 2013-11-22 21:21
| 
