同样方法操作，速度相差很多

t小宝

123循环的记录集："select 表_指令调拨表.流水号 from 表_指令调拨表 group by 表_指令调拨表.流水号 order by 表_指令调拨表.流水号"
有5737条记录，
db1循环的记录集：“select tbl.pycode from tbl group by tbl.pycode order by tbl.pycode”
只有484条记录。
谁快谁慢不就很清楚了。

t小宝

使用这个函数，速度可以提高大概三分之一。
合并记录为字符串的一个函数
代码如下：

1. Sub CMDPRINT_Click()
   
2. 
   
3.     CurrentDb.Execute "delete * from 表_调拨明细"
   
4.     t = Timer
   
5.     CurrentDb.Execute "INSERT INTO 表_调拨明细( 流水号, 调拨明细 ) SELECT 表_指令调拨表.流水号, " & _
   
6.         "DMerge('调出单号 & 半成品数量 & 备注','表_指令调拨表','流水号=' & [流水号] & '',',') " & _
   
7.         " FROM 表_指令调拨表 GROUP BY 流水号 ORDER BY 流水号"
   
8. 
   
9.     MsgBox "秏时: " & Timer - t & " 秒"
   
10. 
    
11. End Sub
    
12. 
    
13. Public Function DMerge(Exps As String, Domain As String, _
    
14.     Optional Criteria As String, Optional Separator As String = ";") As String
    
15.    
    
16. '函数功能：  合并指定记录集指定字段值为一个字符串
    
17. '参数说明：
    
18. '  expr :         要合并的字段
    
19. '  domain :     来源表或查询
    
20. '  criteria :      可选,限制记录的条件表达式
    
21. '  Separator : 可选,合并记录的分隔符,默认为分号(;)
    
22. '
    
23. '调用示例：  DMerge("姓名","人员表","性别='" & [性别] & "'",Chr(13) & Chr(10))
    
24. '                以上示例在查询中，使用了换行分隔符，返回换行显示的姓名
    
25. '作      者：  t小雨
    
26. '创建时间：  2009/11/25
    
27. 
    
28. On Error Resume Next
    
29.     Dim rst As New ADODB.Recordset
    
30.     Dim strSql As String
    
31.    
    
32.     strSql = "Select " & Exps & " From " & Domain
    
33.     If Criteria <> "" Then strSql = strSql & " Where " & Criteria
    
34.     rst.Open strSql, CurrentProject.Connection, adOpenStatic, adLockReadOnly, adCmdText
    
35.    
    
36.     If Not rst.EOF Then DMerge = rst.GetString(adClipString, , , Separator)
    
37.     rst.Close
    
38.     Set rst = Nothing
    
39. End Function
    
40. 
    

复制代码

t小宝

这个代码似乎快一点点

1. Sub macro2()
   
2. 
   
3. Dim arr2()
   
4. Dim i As Integer
   
5. Dim a As Integer
   
6. Dim s As String
   
7. Dim e As Double
   
8. 
   
9. Dim rs As ADODB.Recordset
   
10. 
    
11. CurrentDb.Execute "delete * from 表_调拨明细"
    
12. 
    
13. e = Timer
    
14. arr2 = CurrentProject.Connection.Execute("SELECT * FROM 表_指令调拨表 order by 流水号").getrows
    
15. a = UBound(arr2, 2)
    
16. 
    
17. Set rs = New ADODB.Recordset
    
18. sql = "select * from 表_调拨明细"
    
19. 
    
20. With rs
    
21.     .Open sql, CurrentProject.Connection, 3, 3
    
22.     For i = 0 To a
    
23.         If i = 0 Then
    
24.             s = arr2(1, i) & arr2(2, i) & arr2(3, i)
    
25.         ElseIf arr2(0, i) = arr2(0, i - 1) Then
    
26.             s = s & "," & arr2(1, i) & arr2(2, i) & arr2(3, i)
    
27.         ElseIf arr2(0, i) <> arr2(0, i - 1) Then
    
28.             .AddNew
    
29.                 rs("流水号") = arr2(0, i - 1)
    
30.                 rs("调拨明细") = s
    
31.            .Update
    
32.            s = arr2(1, i) & arr2(2, i) & arr2(3, i)
    
33.         End If
    
34.     Next
    
35.      .AddNew
    
36.          rs("流水号") = arr2(0, a)
    
37.          rs("调拨明细") = s
    
38.     .Update
    
39. 
    
40.     MsgBox a + 1 & " " & Timer - e
    
41. End With
    
42. 
    
43. End Sub

复制代码