难题求解：大侠请进！

Question

难题求解：大侠请进！
有个需求是这样的：
员工考勤表：
员工ID  日期  考勤情况  功能实现：
打考勤及查看考勤界面：
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
____年____月             //在这里选择年份及月份－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－//下面是Grid
姓名 26  27  28  29  30  31........................25           //考勤周期(非正常月周期)
张三  出  旷  病  ...........................................
以下略........
要求在上面的表格中打考勤及查看考勤.
请问如何做?

Answer 1

是不是只 想实现你那样的结构，我做过一个类似的，觉得速度不是很好
给你看看Public Sub ShowKQ()   '读取考勤记录
  Dim rs0 As New ADODB.Recordset
  Dim Rs As New ADODB.Recordset
  Dim rs1 As New ADODB.Recordset
  Dim rs2 As New ADODB.Recordset
  Dim rs3 As New ADODB.Recordset
  Dim StrSql1 As String
  Dim Strsql2 As String
  Dim i, j, k, h, m, t, DeptRQ As Integer
  Dim Cols As Boolean
  Dim BeginDate As Date
  On Error GoTo ShowError
  With MSFlexGrid4
       If Trim(Combo8.Text) <> "所有组别" Then
          StrSql1 = "select * from Att_Group where groupname='" & Combo8.Text & "' order by groupno"
       Else
          StrSql1 = "select * from Att_Group order by  groupno"
       End If
       If Trim(Combo7.Text) <> "所有机器" Then
          Strsql2 = " and devid=" & Val(Combo7.Text) & ""
       End If
       
       rs0.Open StrSql1, cn, 1, 3
       If Not rs0.EOF Then
          
        Do While Not rs0.EOF
             If i = 0 Then
                DeptRQ = i
             Else
                DeptRQ = i + 2
               .Rows = .Rows + 4
             End If
             Rs.Open "select * from Att_GroupEmp_view where Groupid=" & Trim(rs0("Groupid")) & " order by empid", cn, 1, 3
             If Not Rs.EOF Then
               .ColAlignment(0) = 4
               .TextMatrix(DeptRQ + 1, 0) = "姓名"
                Do While Not Rs.EOF
                   j = 1
                  .Rows = DeptRQ + 4
                  .TextMatrix(DeptRQ + 2, 0) = Trim(Rs("EmpName"))
                  .TextMatrix(DeptRQ + 3, 0) = Right(Trim(Rs("EmpNo")), 4)
                   BeginDate = DTPicker7.Value
                   
                   Do While BeginDate <= DTPicker8.Value
                      If .TextMatrix(1, 1) <> "" And Cols = False Then
                         .Cols = .Cols + 1
                      End If
                     .ColAlignment(j) = 4
                      If .TextMatrix(DeptRQ + 1, 0) = "姓名" Then
                         .MergeCells = 1
                         .MergeRow(DeptRQ) = True
                         .TextMatrix(DeptRQ, j) = "组别：" + Trim(rs0("GroupName"))
                         .TextMatrix(DeptRQ + 1, j) = Format(BeginDate, "dd") + "日"
                      End If
                      rs1.Open "select distinct empid,kqdate,kqtime,devid ,dateadd(Second, kqtime, 108) As kqtimess from Att_KqdataByGroup where Empid='" & Trim(Rs("Empid")) & "' and kqdate='" & BeginDate & "' " & Strsql2 & " order by kqtime", cn, 1, 3
                      If Not rs1.EOF Then
                        .TextMatrix(DeptRQ + 2, j) = Format(Trim(rs1("kqtimess")), "hh:mm:ss")
                         rs1.MoveLast
                         If Format(Trim(rs1("kqtimess")), "hh:mm:ss") <> Format(CDate(.TextMatrix(DeptRQ + 2, j)), "hh:mm:ss") Then
                            .TextMatrix(DeptRQ + 3, j) = Format(Trim(rs1("kqtimess")), "hh:mm:ss")
                         End If
                      End If
                      rs1.Close
                      BeginDate = BeginDate + 1
                      j = j + 1
                   Loop
                   Rs.MoveNext
                   Cols = True
                   i = DeptRQ + 3
                   DeptRQ = i
                Loop
             End If
             Rs.Close
             Set Rs = Nothing
             rs0.MoveNext
          Loop
'          ProgressBar1.Visible = False
          If .TextMatrix(1, 0) = "" Then
              MsgBox "该组别在这段时间内没有打卡记录！", vbExclamation, "系统提示"
              Combo8.SelStart = 0
              Combo8.SelLength = Len(Combo8.Text)
              Combo8.SetFocus
          End If
       End If
       rs0.Close
       Set rs0 = Nothing
  End With
  Exit Sub
  
ShowError:
  MsgBox err.Description, vbExclamation, "系统提示"
End Sub

Answer 2

Private Sub Command14_Click()  '导为EXCEL
  Dim Xlapp As Excel.Application
  Dim xlwork As Excel.Workbook
  Dim Xlsheet As Excel.Worksheet
  Dim i, j As Integer
  If MSFlexGrid4.TextMatrix(1, 0) <> "" Then
     Set Xlapp = CreateObject("excel.application")
     Set xlwork = Xlapp.Workbooks.Open(App.Path + "\YGLKYSSJBB.xls")
     Set Xlsheet = xlwork.Sheets(1)
     Xlsheet.Cells(1, 1) = "组别代码：" + Trim(Combo8.Text)
     Xlsheet.Cells(1, 4) = "部门：" + Trim(Combo8.Text)
     Xlsheet.Cells(1, 7) = "报表：员工拉卡原始数据"
     Xlsheet.Cells(1, 11) = "日期：" + Format(Trim(DTPicker7.Value), "yyyy年mm月dd日") + "—" + Format(Trim(DTPicker8.Value), "yyyy年mm月dd日")
     For i = 0 To MSFlexGrid4.Rows - 1
         For j = 0 To MSFlexGrid4.Cols - 1
             If Mid(MSFlexGrid4.TextMatrix(i, 1), 1, 2) = "组别" Then
                Xlsheet.Cells(i + 3, j + 1) = MSFlexGrid4.TextMatrix(i, 1)
                Xlsheet.Range("A" + "" & i + 3 & "" + ":AF" + "" & i + 3 & "").Font.Bold = True
                Xlsheet.Range("A" + "" & i + 4 & "" + ":AF" + "" & i + 4 & "").Font.Bold = True
                Exit For
             End If
             Xlsheet.Cells(i + 3, j + 1) = MSFlexGrid4.TextMatrix(i, j)
         Next
     Next
     Xlapp.Visible = True
     Xlsheet.Activate
  End IfEnd Sub

Answer 3

考勤表应该是Access吧
交叉查询就可以：TRANSFORM max(考勤表.考勤情况) AS 考勤情况
SELECT 员工表.姓名
FROM 考勤表 RIGHT JOIN 员工表　ON 考勤表.员工ID = 员工表.ID
WHERE 考勤表.日期 Between #10/26/2004# And #11/25/2004#
GROUP BY 员工表.姓名
PIVOT Format(日期,"D");