|
这个代码似乎快一点点- Sub macro2()
- Dim arr2()
- Dim i As Integer
- Dim a As Integer
- Dim s As String
- Dim e As Double
- Dim rs As ADODB.Recordset
- CurrentDb.Execute "delete * from 表_调拨明细"
- e = Timer
- arr2 = CurrentProject.Connection.Execute("SELECT * FROM 表_指令调拨表 order by 流水号").getrows
- a = UBound(arr2, 2)
- Set rs = New ADODB.Recordset
- sql = "select * from 表_调拨明细"
- With rs
- .Open sql, CurrentProject.Connection, 3, 3
- For i = 0 To a
- If i = 0 Then
- s = arr2(1, i) & arr2(2, i) & arr2(3, i)
- ElseIf arr2(0, i) = arr2(0, i - 1) Then
- s = s & "," & arr2(1, i) & arr2(2, i) & arr2(3, i)
- ElseIf arr2(0, i) <> arr2(0, i - 1) Then
- .AddNew
- rs("流水号") = arr2(0, i - 1)
- rs("调拨明细") = s
- .Update
- s = arr2(1, i) & arr2(2, i) & arr2(3, i)
- End If
- Next
- .AddNew
- rs("流水号") = arr2(0, a)
- rs("调拨明细") = s
- .Update
- MsgBox a + 1 & " " & Timer - e
- End With
- End Sub
复制代码 |
评分
-
查看全部评分
|