批量生成数据,优化代码,节省时间,看看能否做到?谢谢

YANWEI82123300

各位老师我依据下面的代码将数据进行拆分(将这个LEVE_ID_MAX值为15拆分),追加到tblTemp表中,但是出现一个问题所需要时间太长1个多小时,表"tblTemp追踪单整理"一共3000条数据,请问有没有其他VBA代码,来快速生成数据,节省时间,谢谢, 帮助修改一下附件,谢谢 Sub 拆分() On Error Resume Next Dim S As String Dim rst1 As ADODB.Recordset Dim str1 As String Dim x As Integer str1 = "SELECT * FROM tblTemp追踪单整理" Set rst1 = New ADODB.Recordset rst1.Open str1, CurrentProject.Connection, adOpenStatic, adLockReadOnly If rst1.RecordCount > 0 Then     rst1.MoveFirst x = 0 Set rst = CurrentDb.OpenRecordset("tblTemp", dbOpenDynaset)     For i = 1 To rst1.RecordCount         For ii = 1 To rst1.Fields("LEVE_ID_MAX")             S = ii             DoCmd.RunSQL "INSERT INTO tblTemp SELECT '" & S & "' AS LEVE_ID, '" & rst1.Fields("END_ITEM") & "' AS END_ITEM, '" & rst1.Fields("ITEM_DESC") & "' AS ITEM_DESC"          x = x + 1         Next         rst1.MoveNext     Next End If MsgBox "数据更新完毕，此次操作共新增：" & x & " 条记录！", vbInformation + vbOKOnly, "Level_ID数据更新" End Sub

marco

两种方案，一种是关闭系统的警告提示，不改动代码了，效率一般般，先用着。
Sub 拆分()
On Error Resume Next
Dim S As String
Dim rst1 As ADODB.Recordset
Dim str1 As String
Dim x As Integer
Dim VarReturn As Variant
DoCmd.SetWarnings (False) '关闭系统警告
str1 = "SELECT * FROM tblTemp追踪单整理"
Set rst1 = New ADODB.Recordset
rst1.Open str1, CurrentProject.Connection, adOpenStatic, adLockReadOnly
VarReturn = SysCmd(acSysCmdSetStatus, " 数据正在生成中...稍后...  ")
If rst1.RecordCount > 0 Then
    rst1.MoveFirst
x = 0

Set rst = CurrentDb.OpenRecordset("tblTemp", dbOpenDynaset)
    For i = 1 To rst1.RecordCount
        For ii = 1 To rst1.Fields("LEVE_ID_MAX")
            S = ii
            DoCmd.RunSQL "INSERT INTO tblTemp SELECT '" & S & "' AS LEVE_ID, '" & rst1.Fields("END_ITEM") & "' AS END_ITEM, '" & rst1.Fields("ITEM_DESC") & "' AS ITEM_DESC"
         x = x + 1
        Next
        rst1.MoveNext
    Next
End If

'ReturnValue = SysCmd(acSysCmdUpdateMeter, x)
VarReturn = SysCmd(acSysCmdSetStatus, "数据已完成！ ")
MsgBox "数据更新完毕，此次操作共新增：" & x & " 条记录！", vbInformation + vbOKOnly, "Level_ID数据更新"
DoCmd.SetWarnings (True)
End Sub

YANWEI82123300

marco老师您给个快点的代码!行吗?谢谢

as42065300

1. Sub DataSplit()
   
2. Dim rs_a As DAO.Recordset
   
3. Dim rs_b As DAO.Recordset
   
4. Dim s As Double, st$, n&
   
5. s = Timer
   
6. Set rs_a = CurrentDb.OpenRecordset("tblTemp追踪单整理", dbOpenTable, dbReadOnly)
   
7. Set rs_b = CurrentDb.OpenRecordset("select * from tblTemp", dbOpenDynaset)
   
8. Do While Not rs_a.EOF
   
9.     For i = 1 To rs_a![LEVE_ID_MAX]
   
10.         rs_b.AddNew
    
11.         rs_b![LEVE_ID] = i
    
12.         rs_b![END_ITEM] = rs_a![END_ITEM]
    
13.         rs_b!ITEM_DESC = rs_a!ITEM_DESC
    
14.         rs_b.Update
    
15.         n = n + 1
    
16.     Next
    
17.     rs_a.MoveNext
    
18. Loop
    
19. 
    
20. st = Format(Timer - s, "0.000")
    
21. rs_a.Close
    
22. Set rs_a = Nothing
    
23. rs_b.Close
    
24. Set rs_b = Nothing
    
25. MsgBox "用时：" & st & " 秒！新增 ：" & n & " 条记录！"
    
26. End Sub

复制代码

YANWEI82123300

as42065300谢谢您的帮助,太给力了,好快呀!