Private Sub CommandButton1_Click()
Dim i, j, n
Dim cj
Dim gx As Integer, cg As Integer, bm As Integer, xg As Integer
For i = 1 To Sheets.Count '循环清空所有报班表
If Sheets(i).Name <> "员工信息表" Then
Sheets(i).Rows("3:26").ClearContents
End If
Next i
Dim Conn As New ADODB.Connection
Dim rec As New ADODB.Recordset
Dim rst As ADODB.Recordset
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 8.0;HDR=Yes'" '连接EXCEL文件
rec.Open "select 车间 from [员工信息表$] group by 车间", Conn, adOpenStatic, adLockReadOnly
For i = 1 To rec.RecordCount '循环不同的车间
Set rst = New ADODB.Recordset
rst.Open "select 车间,员工姓名,组别,员工卡号 from [员工信息表$] where 车间='" & rec.Fields(0) & "'", Conn, adOpenStatic, adLockReadOnly '打开指定车间的员工信息
For j = 1 To Sheets.Count '循环查找报班的表,匹配打开的指定车间记录集
If Sheets(j).Cells(1, 1) = rec.Fields(0) Then
Sheets(j).Cells(3, 2).CopyFromRecordset rst '粘贴记录
For n = 1 To rst.RecordCount '填写序号
Sheets(j).Cells(n + 2, 1) = n
Next n
Exit For
End If
Next j
rst.Close
rec.MoveNext
Next i
rec.Close
End Sub
存在的问题
1.报班表可能少于员工信息表中的车间数量,需要自己添加.
2.报班表中可填的员工数量,可能小于员工信息表的指定车间的员工数量,需要你自己处理
