请教高指教如何通过do loop添加资料至另个表

Aleo

我希望通过VBA代码对表进行数据归集，我是用 do loop对表进行添加箱号，但我想实现从table1资料添加到table2，如table2资料效果，即，每张订单每按数量10个分一箱，超了的就放在下一箱，我有点犯晕，烦请高手指点！

zhuyiwen

1. Public Sub test()
   
2.     Dim N As Long: N = 10       ' 每箱数量
   
3.     Dim L As Long               ' 每箱空余数
   
4.     Dim No As Long              ' 箱号号
   
5.     Dim OrderID As Long         ' 订单号
   
6.     Dim RL As Long              ' 当前记录剩余数
   
7.    
   
8.     ' 清表2
   
9.     CurrentProject.Connection.Execute "DELETE * FROM Table2"
   
10.    
    
11.     Dim rs As ADODB.Recordset   ' 遍历记录集
    
12.    
    
13.     Dim sql As String           ' SQL 语句用于查找Table1, 按订单号排序
    
14.     sql = "select * from table1 order by 订单号"
    
15.    
    
16.     Set rs = CurrentProject.Connection.Execute(sql)
    
17.    
    
18.     Do While Not rs.EOF
    
19.         If OrderID <> rs("订单号") Then
    
20.             OrderID = rs("订单号")
    
21.             No = 1
    
22.             L = N
    
23.         End If
    
24.         
    
25.         RL = rs("数量")
    
26.         Do While RL > 0
    
27.             If RL >= L Then
    
28.                 ' 满一箱
    
29.                 sql = "INSERT INTO Table2 (订单号, 产品, 数量, 箱号) VALUES (" & _
    
30.                     OrderID & ", " & _
    
31.                     "'" & rs("产品") & "', " & _
    
32.                     L & ", " & _
    
33.                     No & ")"
    
34.                 RL = RL - L
    
35.                 L = N
    
36.                 No = No + 1
    
37.             Else
    
38.                 ' 不满一箱
    
39.                 sql = "INSERT INTO Table2 (订单号, 产品, 数量, 箱号) VALUES (" & _
    
40.                     OrderID & ", " & _
    
41.                     "'" & rs("产品") & "', " & _
    
42.                     RL & ", " & _
    
43.                     No & ")"
    
44.                 L = L - RL
    
45.                 RL = 0
    
46.             End If
    
47.             CurrentProject.Connection.Execute sql
    
48.         Loop
    
49.         
    
50.         rs.MoveNext
    
51.     Loop
    
52.     rs.Close
    
53.     Set rs = Nothing
    
54. End Sub

复制代码

Aleo

zhuyiwen 发表于 2014-3-20 14:06

谢谢zhuyiwen老师！

Aleo

zhuyiwen 发表于 2014-3-20 14:06

看看老师您的版本，您的代码几段搞定，再看看自己这段，突然间觉得自己好菜鸟。唉！！！路漫漫其修远兮 吾将上下而求索

Public Sub test()

    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
   
   
   
    Dim DN As String 'DN
    Dim Item As String 'Item
   
    Dim s As Integer
    Dim Qty1 As Integer 'Qty1
    Dim Qty2 As Integer 'Qty2
    Dim Qty3, Qty4 As Integer 'Qty3,Qty4
    Dim xiang As Integer
   
    Dim SQL As String
   
    Dim mark
   
    s = 0
    Qty2 = 0
    xiang = 0
   
    rs.Open "TABLE1", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
      
   
    Do Until rs.EOF     '设定循环条件：直到记录集的指针移动到空记录时，停止循环
   
    Qty2 = rs.Fields("数量")
   

    If xiang = 0 Then
        xiang = 1
        DN = rs.Fields("订单号")
        Item = rs.Fields("产品")
        Qty3 = rs.Fields("数量")
        
        SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty2 & "','" & xiang & "')"
        DoCmd.SetWarnings False
        DoCmd.RunSQL SQL
    Else
   
        If DN = rs.Fields("订单号") Then  '订单号相同时
            Item = rs.Fields("产品")
            Qty4 = Qty3
            Qty3 = Qty3 + rs.Fields("数量")
            If Qty3 >= 10 Then             '大于10时
               
                If Qty3 > 20 Then
                s = 0
                Qty3 = Qty3 - 10
                Qty1 = Qty3 \ 10
               
                Qty4 = 10 - Qty4
                SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty4 & "','" & xiang & "')"
                DoCmd.RunSQL SQL
                xiang = xiang + 1
               
                Do
                s = s + 1
                SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & 10 & "','" & xiang & "')"
                DoCmd.RunSQL SQL
                xiang = xiang + 1
                Loop Until s = Qty1
               
                Qty3 = Qty3 Mod 10
               
                Else
                Qty3 = Qty3 - 10
                Qty2 = Qty2 - Qty3
               
                SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty2 & "' ,'" & xiang & "')"
                DoCmd.RunSQL SQL
                xiang = xiang + 1
                mark = "x"
                End If
               
                SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty3 & "','" & xiang & "')"
                DoCmd.RunSQL SQL
        
            Else                             '小于10时
                SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty2 & "','" & xiang & "')"
                DoCmd.RunSQL SQL
                mark = "y"
            End If
        
        Else                                 '订单号不相同时
            xiang = 1
            DN = rs.Fields("订单号")
            Item = rs.Fields("产品")
            Qty3 = rs.Fields("数量")
            
            If Qty2 > 10 Then
            Qty1 = Qty2 \ 10
            Qty3 = Qty2 Mod 10
            
            Do
            s = s + 1
            SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & 10 & "','" & xiang & "')"
            DoCmd.RunSQL SQL
            xiang = xiang + 1
            Loop Until s = Qty1
            
            SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty3 & "','" & xiang & "')"
            DoCmd.RunSQL SQL
            
            ElseIf Qty2 = 10 Then
            SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & 10 & "','" & xiang & "')"
            DoCmd.RunSQL SQL
            
            Else
            SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty2 & "','" & xiang & "')"
            DoCmd.RunSQL SQL
            End If
            mark = ""
        End If
   
    End If
   
    rs.MoveNext
        
    Loop    '循环
   
    If mark = "x" Then
        SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty3 & "','" & xiang & "')"
        DoCmd.RunSQL SQL
        DoCmd.SetWarnings True
    End If
   
    rs.Close    '关闭记录集
    Set rs = Nothing    '将记录集从内存中清除

End Sub

Aleo

1. Public Sub test()
   
2. 
   
3.     Dim rs As ADODB.Recordset
   
4.     Set rs = New ADODB.Recordset
   
5.    
   
6.    
   
7.    
   
8.     Dim DN As String 'DN
   
9.     Dim Item As String 'Item
   
10.    
    
11.     Dim s As Integer
    
12.     Dim Qty1 As Integer 'Qty1
    
13.     Dim Qty2 As Integer 'Qty2
    
14.     Dim Qty3, Qty4 As Integer 'Qty3,Qty4
    
15.     Dim xiang As Integer
    
16.    
    
17.     Dim SQL As String
    
18.    
    
19.     Dim mark
    
20.    
    
21.     s = 0
    
22.     Qty2 = 0
    
23.     xiang = 0
    
24.    
    
25.     rs.Open "TABLE1", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
    
26.       
    
27.    
    
28.     Do Until rs.EOF     '设定循环条件：直到记录集的指针移动到空记录时，停止循环
    
29.    
    
30.     Qty2 = rs.Fields("数量")
    
31.    
    
32. 
    
33.     If xiang = 0 Then
    
34.         xiang = 1
    
35.         DN = rs.Fields("订单号")
    
36.         Item = rs.Fields("产品")
    
37.         Qty3 = rs.Fields("数量")
    
38.         
    
39.         SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty2 & "','" & xiang & "')"
    
40.         DoCmd.SetWarnings False
    
41.         DoCmd.RunSQL SQL
    
42.     Else
    
43.    
    
44.         If DN = rs.Fields("订单号") Then  '订单号相同时
    
45.             Item = rs.Fields("产品")
    
46.             Qty4 = Qty3
    
47.             Qty3 = Qty3 + rs.Fields("数量")
    
48.             If Qty3 >= 10 Then             '大于10时
    
49.                
    
50.                 If Qty3 > 20 Then
    
51.                 s = 0
    
52.                 Qty3 = Qty3 - 10
    
53.                 Qty1 = Qty3 \ 10
    
54.                
    
55.                 Qty4 = 10 - Qty4
    
56.                 SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty4 & "','" & xiang & "')"
    
57.                 DoCmd.RunSQL SQL
    
58.                 xiang = xiang + 1
    
59.                
    
60.                 Do
    
61.                 s = s + 1
    
62.                 SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & 10 & "','" & xiang & "')"
    
63.                 DoCmd.RunSQL SQL
    
64.                 xiang = xiang + 1
    
65.                 Loop Until s = Qty1
    
66.                
    
67.                 Qty3 = Qty3 Mod 10
    
68.                
    
69.                 Else
    
70.                 Qty3 = Qty3 - 10
    
71.                 Qty2 = Qty2 - Qty3
    
72.                
    
73.                 SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty2 & "' ,'" & xiang & "')"
    
74.                 DoCmd.RunSQL SQL
    
75.                 xiang = xiang + 1
    
76.                 mark = "x"
    
77.                 End If
    
78.                
    
79.                 SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty3 & "','" & xiang & "')"
    
80.                 DoCmd.RunSQL SQL
    
81.         
    
82.             Else                             '小于10时
    
83.                 SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty2 & "','" & xiang & "')"
    
84.                 DoCmd.RunSQL SQL
    
85.                 mark = "y"
    
86.             End If
    
87.         
    
88.         Else                                 '订单号不相同时
    
89.             xiang = 1
    
90.             DN = rs.Fields("订单号")
    
91.             Item = rs.Fields("产品")
    
92.             Qty3 = rs.Fields("数量")
    
93.             
    
94.             If Qty2 > 10 Then
    
95.             Qty1 = Qty2 \ 10
    
96.             Qty3 = Qty2 Mod 10
    
97.             
    
98.             Do
    
99.             s = s + 1
    
100.             SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & 10 & "','" & xiang & "')"
     
101.             DoCmd.RunSQL SQL
     
102.             xiang = xiang + 1
     
103.             Loop Until s = Qty1
     
104.             
     
105.             SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty3 & "','" & xiang & "')"
     
106.             DoCmd.RunSQL SQL
     
107.             
     
108.             ElseIf Qty2 = 10 Then
     
109.             SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & 10 & "','" & xiang & "')"
     
110.             DoCmd.RunSQL SQL
     
111.             
     
112.             Else
     
113.             SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty2 & "','" & xiang & "')"
     
114.             DoCmd.RunSQL SQL
     
115.             End If
     
116.             mark = ""
     
117.         End If
     
118.    
     
119.     End If
     
120.    
     
121.     rs.MoveNext
     
122.         
     
123.     Loop    '循环
     
124.    
     
125.     If mark = "x" Then
     
126.         SQL = "INSERT INTO TABLE2 ([订单号],[产品],[数量],[箱号]) VALUES ('" & DN & "','" & Item & "','" & Qty3 & "','" & xiang & "')"
     
127.         DoCmd.RunSQL SQL
     
128.         DoCmd.SetWarnings True
     
129.     End If
     
130.    
     
131.     rs.Close    '关闭记录集
     
132.     Set rs = Nothing    '将记录集从内存中清除
     
133. 
     
134. End Sub

复制代码