Office中国论坛/Access中国论坛

标题: 如何提高这个模块的速度？ [打印本页]

作者: lhsh 时间: 2008-1-26 18:08
标题: 如何提高这个模块的速度？
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 时间: 2008-1-26 18:31
1、2、。。。。。9 个记录集，一个字晕
没说明，没要求和结果，何从修改
上传例子，方便别人测试

作者: huangqinyong 时间: 2008-1-26 18:52
楼主为何把例子传上来，你这段代码让别人如何测试？．

作者: lhsh 时间: 2008-1-26 21:01
[local]1[/local]

作者: lhsh 时间: 2008-1-26 21:04
[attach]28214[/attach]

作者: lhsh 时间: 2008-1-26 21:08
[local]1[/local]

作者: lhsh 时间: 2008-1-26 21:11
数据3000多条的时候需要一分多钟

作者: pcxj 时间: 2008-1-26 23:26
楼主为何把例子传上来，你这段代码让别人如何测试？．

作者: andymark 时间: 2008-1-26 23:52

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

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

作者: lhsh 时间: 2008-1-27 08:00
根据考核人、考项，当每项<19，直接取平均数，>19，减去一个最大和一个最小值；>39，减去2个最大和2个最小值后的平均值；>59，减去3个最大和3个最小值后的平均值；>79，减去4个最大和4个最小值后的平均值；>99，减去5个最大和5个最小值后的平均值

作者: lhsh 时间: 2008-1-27 08:26
[attach]28216[/attach]数据传上

作者: lhsh 时间: 2008-1-27 17:09

原帖由 andymark 于 2008-1-26 23:52 发表

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

ding

请直教

作者: de220 时间: 2008-1-28 20:28

:handshake

作者: lhsh 时间: 2008-2-1 09:04

原帖由 huangqinyong 于 2008-1-26 18:52 发表
楼主为何把例子传上来，你这段代码让别人如何测试？．

请指教

作者: goto2008 时间: 2008-2-1 10:56

帮你顶一下

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)