Office中国论坛/Access中国论坛

标题: 请教高指教如何通过do loop添加资料至另个表 [打印本页]
作者: Aleo    时间: 2014-3-19 13:29
标题: 请教高指教如何通过do loop添加资料至另个表
我希望通过VBA代码对表进行数据归集，我是用 do loop对表进行添加箱号，但我想实现从table1资料添加到table2，如table2资料效果，即，每张订单每按数量10个分一箱，超了的就放在下一箱，我有点犯晕，烦请高手指点！
作者: zhuyiwen    时间: 2014-3-20 14:06
  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
复制代码


[attach]53619[/attach]
作者: Aleo    时间: 2014-3-21 10:31
zhuyiwen 发表于 2014-3-20 14:06

谢谢zhuyiwen老师！
作者: Aleo    时间: 2014-3-21 10:48
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    时间: 2014-3-21 10:51
  1. Public Sub test()

  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.    

  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    '将记录集从内存中清除

  134. End Sub
复制代码





欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3