统计的原代码是这样的
Option Explicit
Private firstday As String
Private lastday As String
Private Sub cmdcancel_Click()
  Unload Me
  Exit Sub
End Sub
Public Sub resumsalary(recorddate As Date)
   Dim sql As String
   Dim days As Integer
   Dim rs As New ADODB.Recordset
   firstday = Year(recorddate) & "-" & Month(recorddate) & "-1"
   days = DateDiff("d", Year(recorddate) & "-" & Month(recorddate) & "-1", _
                            Year(recorddate) & "-" & Month(recorddate) + 1 & "-1")
   lastday = Year(recorddate) & "-" & Month(recorddate) & "-" & days
   sql = "select * from salarystatistics where yearmonth between #" & firstday & "# and #"
   sql = sql & lastday & "#"
   Set rs = getrs(sql, "salary")
   If rs.EOF = False Then
     sql = "delete from salarystatistics where yearmonth between #" & firstday & "# and #"
     sql = sql & lastday & "#"
     Call transactsql(sql, "salary")
   End If
   rs.Close
   sql = "select * from salarystatistics"
   Call sumsalary(firstday, lastday)
   Call frmresult.listtopic
   Call frmresult.showdata(sql)
   frmresult.ZOrder 0
End Sub
Private Sub cmdok_Click()
  Dim sql As String
  Dim days As Integer
  If Me.commonth.Text = 4 Then
   firstday = Year(Date) & "-" & Me.commonth.Text & "-1"
   days = DateDiff("d", Year(Date) & "-" & Me.commonth.Text & "-1", _
                            Year(Date) & "-" & Me.commonth.Text + 1 & "-1")
   lastday = Year(Date) & "-" & Me.commonth.Text & "-" & days
   Call sumsalary(firstday, lastday)
   sql = "select * from salarystatistics"
   frmresult.SSTab1.Caption = "员工工资统计列表"
   Call frmresult.listtopic
   Call frmresult.showdata(sql)
   frmresult.Caption = "统计结果列表"
   frmresult.ZOrder 0
   Unload Me
  Else
   MsgBox "这个月的工资未统计", vbOKOnly + vbExclamation, "提示"
  End If
End Sub
Public Sub sumsalary(begintime As String, endtime As String)
   Dim sql As String
   Dim rs As New ADODB.Recordset
   Dim rsformula As New ADODB.Recordset
   Dim rsothers As New ADODB.Recordset
   Dim rsbasic As New ADODB.Recordset
   Dim rsnew As New ADODB.Recordset
   Dim dbonus As Double
   Dim dwelfare As Double
   Dim dallowance As Double
   Dim dsub As Double
   Dim dothers As Double
   Dim dtotal As Double
   sql = "select * from salarystatistics where yearmonth between #" & begintime & "# and #"
   sql = sql & endtime & "#"
   Set rs = getrs(sql, "salary")
   If rs.EOF = False Then
      MsgBox "已经统计", vbOKOnly + vbExclamation, "提示"
      frmresult.Show
      frmresult.ZOrder 0
      Unload Me
      Exit Sub
   End If
   sql = "select * from attendancestatistics where recordmonth between #" & begintime & "# and #"
   sql = sql & endtime & "#"
   Set rs = getrs(sql, "salary")
   If rs.EOF = False Then
     While Not rs.EOF
       dbonus = 0
       dwelfare = 0
       dallowance = 0
       dsub = 0
       dothers = 0
       dtotal = 0
       sql = "select * from salarysetting where stuffid='"
       sql = sql & rs(1) & "'"
       Set rsbasic = getrs(sql, "salary")
       sql = "select * from salaryother where yearmonth between #" & begintime & "# and #"
       sql = sql & endtime & "# and stuffid='" & rs(1) & "'"
       Set rsothers = getrs(sql, "salary")
       While Not rsothers.EOF
          If rsothers(3) = 1 Then
             dbonus = rsothers(5) + dbonus
          End If
          If rsothers(3) = 2 Then
             dallowance = rsothers(5) + dallowance
          End If
          If rsothers(3) = 3 Then
             dwelfare = rsothers(5) + dwelfare
          End If
          If rsothers(3) = 4 Then
             dsub = rsothers(5) + dsub
          End If
          If rsothers(3) = 5 Then
             dothers = rsothers(5) + dothers
          End If
          rsothers.MoveNext
       Wend
       sql = "select * from formulasetting"
       Set rsformula = getrs(sql, "salary")
       dtotal = rsbasic(3) * rs(4) * 8 + dbonus + dwelfare + dallowance + dothers - dsub
       dtotal = dtotal - rs(5) * rsformula(4) - rs(6) * rsformula(3)
       dtotal = dtotal + rs(7) * (rsformula(0) / 100) * rsbasic(3) * 8
       dtotal = dtotal + rs(8) * (rsformula(1) / 100) * rsbasic(3) * 8
       dtotal = dtotal + rs(9) * rsformula(2)
       sql = "select * from salarystatistics"
       Set rsnew = getrs(sql, "salary")
       rsnew.Fields(1) = rs(1)
       rsnew.Fields(2) = rs(2)
       rsnew.Fields(3) = rs(3)
       rsnew.Fields(4) = rsbasic(3) * rs(4) * 8
       rsnew.Fields(5) = dbonus
       rsnew.Fields(6) = dwelfare
       rsnew.Fields(7) = dallowance
       rsnew.Fields(8) = dsub
       rsnew.Fields(9) = rs(5) * rsformula(4)
       rsnew.Fields(10) = rs(6) * rsformula(3)
       rsnew.Fields(11) = rs(7) * (rsformula(0) / 100) * rsbasic(3) * 8 + _
                          rs(8) * (rsformula(1) / 100) * rsbasic(3) * 8
       rsnew.Fields(12) = rs(9) * rsformula(2)
       rsnew.Fields(13) = dothers
       rsnew.Fields(14) = dtotal
       rsnew.Update
       rsnew.Close
       rsothers.Close
       rs.MoveNext
    Wend
    rs.Close
    rsformula.Close
    rsbasic.Close
    MsgBox "统计完毕", vbOKOnly + vbExclamation, "提示"
  End If
  End Sub
Private Sub Form_Load()
    Dim i As Integer
    For i = 1 To 12
        Me.commonth.AddItem i
    Next i
    Me.commonth.ListIndex = 0
End Sub