如何提高这个模块的速度？

lhsh

Function uf_getfld()
  Debug.Print uf_GetfldName("中层")
End Function
Public Function uf_GetfldName(strSourceTable As String) As String
  Dim rst As DAO.Recordset
  Dim fldName As String
  Set rst = CurrentDb.OpenRecordset(strSourceTable)
  Dim i As Integer
For i = 0 To rst.Fields.Count - 1
  'fldName = fldName & "nz([" & rst.Fields(i).Name & "])+"
  fldName = fldName & rst.Fields(i).Name & ","
Next
  uf_GetfldName = fldName
End Function
Sub aExcuteEvents()
  CurrentProject.Connection.Execute "delete * from tblcalfliter"
  Dim rsyg As New ADODB.Recordset
  rsyg.Open "qrykxcount", CurrentProject.Connection, 1, 2
Do While Not rsyg.EOF
  goFindrec rsyg("被考核人员"), rsyg("考项"), "中层", "tblCalFliter"
  rsyg.MoveNext
Loop
End Sub
Sub goFindrec(strXm As String, strKx As String, TblName As String, AddSql As String)
  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 rs4 As New ADODB.Recordset
  Dim rs5 As New ADODB.Recordset
  Dim rs6 As New ADODB.Recordset
  Dim rs7 As New ADODB.Recordset
  Dim rs8 As New ADODB.Recordset
  Dim rs9 As New ADODB.Recordset
  Dim fld(9) As String
  Dim sql(9) As String
  fld(0) = "工作责任心"
  fld(1) = "敬业精神"
  fld(2) = "执行力度"
  fld(3) = "积极主动"
  fld(4) = "办事公道"
  fld(5) = "廉洁自律"
  fld(6) = "创新精神"
  fld(7) = "全局观念"
  fld(8) = "团结协作意识"
  fld(9) = "工作能力及方法"
  Dim strCri As String
  strCri = "[被考核人员]='" & strXm & "' and [考项]='" & strKx & "'"
  Debug.Print strCri
  Dim intKxCount As Integer
  intKxCount = DCount("考项", TblName, strCri)
  Debug.Print "被考核人员的考项数:" & intKxCount
  sql(0) = "select " & fld(0) & " from " & TblName & " where " & strCri & " order by " & fld(0)
  sql(1) = "select " & fld(1) & " from " & TblName & " where " & strCri & " order by " & fld(1)
  sql(2) = "select " & fld(2) & " from " & TblName & " where " & strCri & " order by " & fld(2)
  sql(3) = "select " & fld(3) & " from " & TblName & " where " & strCri & " order by " & fld(3)
  sql(4) = "select " & fld(4) & " from " & TblName & " where " & strCri & " order by " & fld(4)
  sql(5) = "select " & fld(5) & " from " & TblName & " where " & strCri & " order by " & fld(5)
  sql(6) = "select " & fld(6) & " from " & TblName & " where " & strCri & " order by " & fld(6)
  sql(7) = "select " & fld(7) & " from " & TblName & " where " & strCri & " order by " & fld(7)
  sql(8) = "select " & fld(8) & " from " & TblName & " where " & strCri & " order by " & fld(8)
  sql(9) = "select " & fld(9) & " from " & TblName & " where " & strCri & " order by " & fld(9)
  rs.Open sql(0), CurrentProject.Connection, 1, 2
  rs1.Open sql(1), CurrentProject.Connection, 1, 2
  rs2.Open sql(2), CurrentProject.Connection, 1, 2
  rs3.Open sql(3), CurrentProject.Connection, 1, 2
  rs4.Open sql(4), CurrentProject.Connection, 1, 2
  rs5.Open sql(5), CurrentProject.Connection, 1, 2
  rs6.Open sql(6), CurrentProject.Connection, 1, 2
  rs7.Open sql(7), CurrentProject.Connection, 1, 2
  rs8.Open sql(8), CurrentProject.Connection, 1, 2
  rs9.Open sql(9), CurrentProject.Connection, 1, 2
  Debug.Print "记录集的记录数:" & rs.RecordCount
    Dim i As Integer
    Dim j As Integer
    Select Case intKxCount
        Case Is <= 19
        j = 0
        Case Is <= 39
        j = 1
        Case Is <= 59
        j = 2
        Case Is <= 79
        j = 3
        Case Is > 79
        j = 4
    End Select
    Debug.Print "筛除记录数:" & j & "×2"
  Dim rsCal As New ADODB.Recordset
  rsCal.Open AddSql, CurrentProject.Connection, 1, 2
  rs.Move j
  rs1.Move j
  rs2.Move j
  rs3.Move j
  rs4.Move j
  rs5.Move j
  rs6.Move j
  rs7.Move j
  rs8.Move j
  rs9.Move j
  For i = 1 To intKxCount - j * 2
    rsCal.AddNew
    rsCal("id") = rs.AbsolutePosition
    rsCal("被考核人员") = strXm
    rsCal("考项") = strKx
    rsCal(fld(0)) = rs(fld(0))
    rsCal(fld(1)) = rs1(fld(1))
    rsCal(fld(2)) = rs2(fld(2))
    rsCal(fld(3)) = rs3(fld(3))
    rsCal(fld(4)) = rs4(fld(4))
    rsCal(fld(5)) = rs5(fld(5))
    rsCal(fld(6)) = rs6(fld(6))
    rsCal(fld(7)) = rs7(fld(7))
    rsCal(fld(8)) = rs8(fld(8))
    rsCal(fld(9)) = rs9(fld(9))
    rsCal.Update
    rs.MoveNext
    rs1.MoveNext
    rs2.MoveNext
    rs3.MoveNext
    rs4.MoveNext
    rs5.MoveNext
    rs6.MoveNext
    rs7.MoveNext
    rs8.MoveNext
    rs9.MoveNext
Next i
End Sub

andymark

1、2、。。。。。9 个记录集，一个字晕
没说明，没要求和结果，何从修改
上传例子，方便别人测试

huangqinyong

楼主为何把例子传上来，你这段代码让别人如何测试？．

lhsh

[local]1[/local]

lhsh

lhsh

[local]1[/local]

lhsh

数据3000多条的时候需要一分多钟

pcxj

楼主为何把例子传上来，你这段代码让别人如何测试？．

andymark

原帖由 lhsh 于 2008-1-26 21:11 发表
数据3000多条的时候需要一分多钟

数据库里没数据怎么测试
同时请楼主把要求说出来,方便别人修改

lhsh

根据考核人、考项，当每项<19，直接取平均数，>19，减去一个最大和一个最小值；>39，减去2个最大和2个最小值后的平均值；>59，减去3个最大和3个最小值后的平均值；>79，减去4个最大和4个最小值后的平均值；>99，减去5个最大和5个最小值后的平均值