VBA实例

By | 2014年12月11日

这是一段用来统计每个人值班天数的代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Dim i, s, x As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim name As String

name = "name1"
Call GetCountWorkDay(name)
Cells(2, 8).Value = s
Cells(2, 9).Value = x

name = "name2"
Call GetCountWorkDay(name)
Cells(3, 8).Value = s
Cells(3, 9).Value = x

End Sub

Private Sub GetCountWorkDay(name As String)

s = 0
x = 0

For i = 1 To 10000
If Cells(i, 5).Value Like "*" + name + "*" Then
If Cells(i, 3).Value = "上午" Then
s = s + 1
End If
If Cells(i, 3).Value = "下午" Then
x = x + 1
End If
End If
Next

End Sub

一段用来自动生成排班表的代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Sub Macro1()

'初始化
Dim r_ld, r_yg1, r_yg2 As Integer
'定义sheet1的起始行
Dim sheet1_start_row As Integer
sheet1_start_row = 2
'获取人员行数
Dim sum_people, start_row As Integer
sum_people = 0
start_row = 2
Do While True
If Sheet2.Cells(start_row, 1).Value <> "" Then
sum_people = sum_people + 1
start_row = start_row + 1
Else
Exit Do
End If
Loop

'Sheet2.Cells(1, 7) = sum_people

While Application.WorksheetFunction.Sum(Sheet2.Range("f2:f1000")) > 0

Dim temp_row As Integer
Dim lastday, lastday1, lastday2 As Integer '未分配的班次

'找领导
lastday = 0
For temp_row = 2 To sum_people + start_row - 1 Step 1
If Sheet2.Cells(temp_row, 2).Value = 1 And Sheet2.Cells(temp_row, 6).Value > lastday Then
r_ld = temp_row
lastday = Sheet2.Cells(r_ld, 6).Value
End If
Next

'找员工1
lastday1 = 0
For temp_row = 2 To sum_people + start_row - 1 Step 1
If temp_row <> r_ld Then
If Sheet2.Cells(temp_row, 6).Value > lastday1 Then
r_yg1 = temp_row
lastday1 = Sheet2.Cells(r_yg1, 6).Value
End If
End If
Next

'找员工2
lastday2 = 0
For temp_row = 2 To sum_people + start_row - 1 Step 1
If temp_row <> r_ld And temp_row <> r_yg1 Then
If Sheet2.Cells(temp_row, 6).Value > lastday2 Then
r_yg2 = temp_row
lastday2 = Sheet2.Cells(r_yg2, 6).Value
End If
End If
Next

'放置领导不够分
If lastday <= 0 Then
lastday = 0
For temp_row = 2 To sum_people + start_row - 1 Step 1
If temp_row <> r_yg1 And temp_row <> r_yg2 Then
If Sheet2.Cells(temp_row, 6).Value > lastday Then
r_ld = temp_row
lastday = Sheet2.Cells(r_ld, 6).Value
End If
End If
Next
End If

'在sheet1中记录结果,并减去sheet2中的天数
Sheet1.Cells(sheet1_start_row, 2) = Sheet2.Cells(r_ld, 1).Value
Sheet1.Cells(sheet1_start_row, 3) = Sheet2.Cells(r_yg1, 1).Value
Sheet1.Cells(sheet1_start_row, 4) = Sheet2.Cells(r_yg2, 1).Value
sheet1_start_row = sheet1_start_row + 1
Sheet2.Cells(r_ld, 6).Value = CLng(Sheet2.Cells(r_ld, 6).Value) - 1
Sheet2.Cells(r_yg1, 6).Value = CLng(Sheet2.Cells(r_yg1, 6).Value) - 1
Sheet2.Cells(r_yg2, 6).Value = CLng(Sheet2.Cells(r_yg2, 6).Value) - 1

Wend

End Sub

发表回复