[Temp]

Module

Function Shift_Allowance(ShtName As String)
    'Application.ScreenUpdating = False
    Dim TargetStaff As String
    Dim Sht As Worksheet, Sht0 As Worksheet
    Dim i As Integer, j As Integer, i0 As Integer, j0 As Integer, j1 As Integer
    Dim DateRow As Integer
    Dim iMax As Integer, jMax As Integer
    Dim Num As Integer
    Set Sht = Sheets(ShtName) 'Target Sheet
    Set Sht0 = Sheets("Shift Allowance Form")
'/找到日期所在行/
    Do
        i = i + 1
        If StrComp(Sht.Cells(i, 1), "name", 1) = 0 Then
            DateRow = i
        End If
    Loop Until DateRow = i
'/计算当月天数/
    Do
        jMax = jMax + 1
    Loop Until Sht.Cells(DateRow, jMax + 1) = ""
'/总人数所在行/
    iMax = DateRow
    Do
        iMax = iMax + 1
    Loop Until Sht.Cells(iMax + 1, 1) = "" And Sht.Cells(iMax + 2, 1) = ""
'====================================================================================
    i = DateRow     'Selection Row
    i0 = 13
    Do
        i = i + 1
        TargetStaff = Sht.Cells(i, 1)
        If Staff_Name(TargetStaff) = TargetStaff Then
            j = 1
            Do
                j = j + 1
                '/判断MA及NB/
                If InStr(1, Sht.Cells(i, j), "MA", vbTextCompare) Then
                    Sht.Cells(i, j) = "MA"
                ElseIf InStr(1, Sht.Cells(i, j), "NB", vbTextCompare) Then
                    Sht.Cells(i, j) = "NB"
                End If
                '================================================================================================
                If InStr(1, "|MA|NB|EB|", "|" & Sht.Cells(i, j) & "|", vbTextCompare) Then
                '等价于If Sht.Cells(i,j) = "MA" Or Sht.Cells(i,j) = "NB" Or Sht.Cells(i,j) = "EB"
                    With Sht0
                        Num = Num + 1
                        .Cells(i0, 1) = Num
                        .Cells(i0, 2) = Staff_ID(TargetStaff)
                        .Cells(i0, 3) = Staff_Name(TargetStaff)
                        .Cells(i0, 10) = Staff_LN(TargetStaff)
                        If Sht.Cells(i, j) = "MA" Then
                            .Cells(i0, 8) = "1st Shift"
                            .Cells(i0, 9) = "7:30 - 16:30"
                        ElseIf Sht.Cells(i, j) = "NB" Then
                            .Cells(i0, 8) = "2nd Shift"
                            .Cells(i0, 9) = "13:00 - 22:00"
                        ElseIf Sht.Cells(i, j) = "EB" Then
                            .Cells(i0, 8) = "3rd Shift"
                            .Cells(i0, 9) = "22:00 - 8:00"
                        End If
                        j0 = j
                        Do
                            j = j + 1
                            If InStr(1, Sht.Cells(i, j), "MA", vbTextCompare) Then
                                Sht.Cells(i, j) = "MA"
                            ElseIf InStr(1, Sht.Cells(i, j), "NB", vbTextCompare) Then
                                Sht.Cells(i, j) = "NB"
                            End If
                        Loop Until Sht.Cells(i, j0) <> Sht.Cells(i, j)
                        j1 = j - 1
                        .Cells(i0, 4) = Sht.Cells(DateRow, j0)
                        .Cells(i0, 5) = Sht.Cells(DateRow, j1)
                        .Cells(i0, 7) = j1 - j0 + 1
                    End With
                    i0 = i0 + 1
                    Sht0.Rows(i0).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove '插入新一行
                End If
            Loop Until j = jMax + 1
        End If
    Loop Until i = iMax + 1
'    Application.ScreenUpdating = True
End Function

Function Staff_ID(TargetStaff As String)
    For a = 2 To Sheets("StaffInfo").Range("A" & Rows.Count).End(xlUp).Row
        If TargetStaff = Sheets("StaffInfo").Cells(a, 2) Then Exit For
    Next a
    Staff_ID = Sheets("StaffInfo").Cells(a, 1)
End Function

Function Staff_Name(TargetStaff As String)
    For a = 2 To Sheets("StaffInfo").Range("A" & Rows.Count).End(xlUp).Row
        If TargetStaff = Sheets("StaffInfo").Cells(a, 2) Then Exit For
    Next a
    Staff_Name = Sheets("StaffInfo").Cells(a, 2)
End Function

Function Staff_LN(TargetStaff As String)
    For a = 2 To Sheets("StaffInfo").Range("A" & Rows.Count).End(xlUp).Row
        If TargetStaff = Sheets("StaffInfo").Cells(a, 2) Then Exit For
    Next a
    Staff_LN = Sheets("StaffInfo").Cells(a, 3)
End Function

Module 2 (For Testing)

 1 Private Sub CommandButton1_Click()
 2 DateRow = 18
 3 Set Sht = Sheets(1)
 4 Dim arr()
 5 Dim arr2()
 6     Do
 7         jMax = jMax + 1
 8     Loop Until Sht.Cells(DateRow, jMax + 1) = ""
 9  i = 53     '当前选中的行
10  If Staff_Name("Phoebe Li") = "Phoebe Li" Then  '判断名字是否相同
11     i0 = 13
12     i8 = i0
13     'ReDim arr2(i0 To i8 + 1, 1 To 10)
14             j = 1 '日期列原点
15             Do
16                 ReDim arr(i0 To i8, 1 To 10)
17                 If i0 <> i8 Then
18                 For a = i0 To i8
19                     For b = 1 To 10
20                         arr(a, b) = arr2(a, b)
21                     Next b
22                 Next a
23                 End If
24                 j = j + 1 '日期递加
25                 '/判断MA及NB/
26                 If InStr(1, Sht.Cells(i, j), "MA", vbTextCompare) Then
27                     Sht.Cells(i, j) = "MA"
28                 ElseIf InStr(1, Sht.Cells(i, j), "NB", vbTextCompare) Then
29                     Sht.Cells(i, j) = "NB"
30                 End If
31                 '================================================================================================
32                 If InStr(1, "|MA|NB|EB|", "|" & Sht.Cells(i, j) & "|", vbTextCompare) Then
33                 '等价于If Sht.Cells(i,j) = "MA" Or Sht.Cells(i,j) = "NB" Or Sht.Cells(i,j) = "EB"
34 '                    With Sht0
35                         Num = Num + 1
36                         arr(i8, 1) = Num
37 '                        .Cells(i0, 1) = Num
38 '                        .Cells(i0, 2) = Staff_ID(TargetStaff)
39 '                        .Cells(i0, 3) = Staff_Name(TargetStaff)
40 '                        .Cells(i0, 10) = Staff_LN(TargetStaff)
41 '                        If Sht.Cells(i, j) = "MA" Then
42 '                            .Cells(i0, 8) = "1st Shift"
43 '                            .Cells(i0, 9) = "7:30 - 16:30"
44 '                        ElseIf Sht.Cells(i, j) = "NB" Then
45 '                            .Cells(i0, 8) = "2nd Shift"
46 '                            .Cells(i0, 9) = "13:00 - 22:00"
47 '                        ElseIf Sht.Cells(i, j) = "EB" Then
48 '                            .Cells(i0, 8) = "3rd Shift"
49 '                            .Cells(i0, 9) = "22:00 - 8:00"
50 '                        End If
51                         If Sht.Cells(i, j) = "MA" Then
52                             arr(i8, 8) = "1st Shift"
53                             arr(i8, 9) = "7:30 - 16:30"
54                         ElseIf Sht.Cells(i, j) = "NB" Then
55                             arr(i8, 8) = "2nd Shift"
56                             arr(i8, 9) = "13:00 - 22:00"
57                         ElseIf Sht.Cells(i, j) = "EB" Then
58                             arr(i8, 8) = "3rd Shift"
59                             arr(i8, 9) = "22:00 - 8:00"
60                         End If
61                         j0 = j
62                         Do
63                             j = j + 1
64                             If InStr(1, Sht.Cells(i, j), "MA", vbTextCompare) Then
65                                 Sht.Cells(i, j) = "MA"
66                             ElseIf InStr(1, Sht.Cells(i, j), "NB", vbTextCompare) Then
67                                 Sht.Cells(i, j) = "NB"
68                             End If
69                         Loop Until Sht.Cells(i, j0) <> Sht.Cells(i, j)
70                         j1 = j - 1
71 '                        .Cells(i0, 4) = Sht.Cells(DateRow, j0)
72 '                        .Cells(i0, 5) = Sht.Cells(DateRow, j1)
73 '                        .Cells(i0, 7) = j1 - j0 + 1
74                         arr(i8, 4) = Sht.Cells(DateRow, j0)
75                         arr(i8, 5) = Sht.Cells(DateRow, j1)
76                         arr(i8, 7) = j1 - j0 + 1
77 '                    End With
78 '                    Sht0.Rows(i0).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove '插入新一行
79                     ReDim arr2(i0 To i8 + 1, 1 To 10)
80                     For a = i0 To i8
81                         For b = 1 To 10
82                             arr2(a, b) = arr(a, b)
83                         Next b
84                     Next a
85                     i8 = i8 + 1
86                 End If
87             Loop Until j = jMax + 1
88     End If
89 End Sub

发表于 2013-02-15 01:19 德臣小朋友阅读(174) 评论(0) 编辑收藏举报

公告