- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2013-11-20 12:23 編輯
回復 21# prince0413 - Const 早 = "10:00~18:00"
- Const 全日 = "10:30~18:30"
- Const 晚 = "11:00~19:00"
- Sub Ex()
- Dim Rng(1 To 3) As Range, i As Integer, ii As Integer, 出勤 As String, 日期 As Range, Print_x As Integer
- Dim 出勤單 As Range, E As Range
- Set 出勤單 = Sheets("假日出勤單").Range("B3,D3,A5,B5,D5") '第1張出勤單要導入資料的位置
- For i = 0 To 3 '出勤單: 第1張到 第4張的位置 間格 14 列
- 出勤單.Offset(i * 14) = "" '清除 資料
- '************ 但第 2- 3張出勤單 間格 15 列 你需調整一下 *************************************
- Next
- Print_x = 0 '印列 A4紙張 的變數
- Set Rng(1) = Sheets("假日出勤單").Range("J2") '設定社員 英文,中文,編號 (可以是 Abby,丁千芸,136)
- Do While Rng(1) <> "" '執行迴圈的條件: 社員<>""
- With Sheets("11月")
- 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) = Sheets("11月").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 Trim(.Cells(Rng(3).Row, i)) <> "" Then
- 出勤 = "" '歸零
- Set 日期 = .Cells(4, i)
- If .Cells(Rng(3).Row, i) Like "*早*" Then
- 出勤 = 早
- ElseIf .Cells(Rng(3).Row, i) Like "*晚*" Then
- 出勤 = 晚
- ElseIf .Cells(Rng(3).Row, i) Like "*全日*" Then
- 出勤 = 全日
- End If
- If 出勤 <> "" Then '預防沒有 [全日,早,晚]的班別
- 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, Round(Print_x / 2) ' 未滿 4 筆的資料沒印列
- End Sub
|
|
發表於 2013-11-19 15:57
| 
