Office中国论坛/Access中国论坛

标题: 请教如何用追加查询分类配额 [打印本页]
作者: lin2003_lin    时间: 2011-12-22 09:28
标题: 请教如何用追加查询分类配额
a表
单号       类别    需求数额    配额    差额
t1101     a01      500            0        -500
t1102     a01      300            0        -300
t1105     b01      600            0        -600
t1107     b01      400            0        -400
t1115     b01      800            0        -800

b表
类别    剩余数量   
a01      1500                     
b01      1200      

如何实现讲b表的数据逐一分配给a表   
得出以下结果
单号       类别    需求数额    配额    差额
t1101     a01      500           500      0
t1102     a01      300           300      0
t1105     b01      600           600      0
t1107     b01      400           400      0
t1115     b01      800           200     -600

   
           
作者: Henry D. Sy    时间: 2011-12-22 10:14
把例子传上来，研究研究！
作者: lin2003_lin    时间: 2011-12-22 11:08
Henry D. Sy 发表于 2011-12-22 10:14
把例子传上来，研究研究！

谢谢赐教！
作者: lin2003_lin    时间: 2011-12-22 11:09
谢谢赐教！
作者: Henry D. Sy    时间: 2011-12-22 11:53
  1. Private Sub Command0_Click()
  2.     Dim rs As New ADODB.Recordset
  3.     Dim rst As New ADODB.Recordset
  4.     Dim cnn As New ADODB.Connection
  5.     Dim sSQL As String
  6.     Dim lngBal As Long
  7.     Set cnn = CurrentProject.Connection
  8.     sSQL = "select  类别,剩余数量 from b"
  9.     rs.Open sSQL, cnn, adOpenKeyset, adLockReadOnly

  11.     Do While Not rs.EOF
  12.         lngBal = rs.Fields("剩余数量")
  13.         sSQL = "select * from a where 类别='" & rs.Fields("类别") & "'"
  14.         rst.Open sSQL, cnn, adOpenKeyset, adLockOptimistic
  15.         With rst
  16.             Do While Not .EOF
  17.                 If lngBal >= .Fields("需求数额") Then
  18.                     .Fields("配额") = .Fields("需求数额")
  19.                 Else
  20.                     .Fields("配额") = lngBal
  21.                 End If
  22.                 .Fields("差额") = .Fields("配额") - .Fields("需求数额")
  23.                 lngBal = lngBal - .Fields("配额")
  24.                 .Update
  25.                 .MoveNext
  26.             Loop
  27.             .Close
  28.         End With
  29.         rs.MoveNext
  30.     Loop
  31.     rs.Close
  32.     Set rs = Nothing
  33.     Set rst = Nothing
  34.     Set cnn = Nothing
  35. End Sub
复制代码
作者: Henry D. Sy    时间: 2011-12-22 12:05
本帖最后由 Henry D. Sy 于 2011-12-22 12:06 编辑

建议在b中增加一字段：分配后余额，用于显示实际库存
则代码调整如下：
  1. Private Sub Command0_Click()
  2.     Dim rs As New ADODB.Recordset
  3.     Dim rst As New ADODB.Recordset
  4.     Dim cnn As New ADODB.Connection
  5.     Dim sSQL As String
  6.     Dim lngBal As Long
  7.     Dim lngUsed As Long
  8.     Set cnn = CurrentProject.Connection
  9.     sSQL = "select  类别,剩余数量,分配后余额 from b"
  10.     rs.Open sSQL, cnn, adOpenKeyset, adLockOptimistic

  12.     Do While Not rs.EOF
  13.         lngBal = rs.Fields("剩余数量")
  14.         lngUsed = 0
  15.         sSQL = "select * from a where 类别='" & rs.Fields("类别") & "'"
  16.         rst.Open sSQL, cnn, adOpenKeyset, adLockOptimistic
  17.         With rst
  18.             Do While Not .EOF
  19.                 If lngBal >= .Fields("需求数额") Then
  20.                     .Fields("配额") = .Fields("需求数额")
  21.                 Else
  22.                     .Fields("配额") = lngBal
  23.                 End If
  24.                 .Fields("差额") = .Fields("配额") - .Fields("需求数额")
  25.                 lngBal = lngBal - .Fields("配额")
  26.                 lngUsed = lngUsed + .Fields("配额")
  27.                 .Update
  28.                 .MoveNext
  29.             Loop
  30.             .Close
  31.         End With
  32.         rs.Fields("分配后余额") = rs.Fields("剩余数量") - lngUsed
  33.         rs.Update
  34.         rs.MoveNext
  35.     Loop
  36.     rs.Close
  37.     Set rs = Nothing
  38.     Set rst = Nothing
  39.     Set cnn = Nothing
  40. End Sub

复制代码
作者: lin2003_lin    时间: 2011-12-22 13:41
谢谢！
万分感谢！应用于窗体很实用。

自己用查询实现！查询“D”的“配额V”，“差额V”得出想要的结果！
作者: lin2003_lin    时间: 2011-12-22 13:41
Henry D. Sy 发表于 2011-12-22 12:05
建议在b中增加一字段：分配后余额，用于显示实际库存
则代码调整如下：

谢谢！
作者: lin2003_lin    时间: 2011-12-22 14:01
Henry D. Sy 发表于 2011-12-22 12:05
建议在b中增加一字段：分配后余额，用于显示实际库存
则代码调整如下：

想要B表追加一次后，后续数字改变了，要继续追加，先判断配额是否足够，已配足的不再配额，不足的继续配足。

请帮我修改一下你的代码。
作者: Henry D. Sy    时间: 2011-12-22 14:55
lin2003_lin 发表于 2011-12-22 14:01
想要B表追加一次后，后续数字改变了，要继续追加，先判断配额是否足够，已配足的不再配额，不足的继续配足 ...

什么意思
作者: Henry D. Sy    时间: 2011-12-22 14:57
先判断配额是否足够，
判断哪个？b表的剩余数量够分吗？
作者: lin2003_lin    时间: 2011-12-22 15:11
Henry D. Sy 发表于 2011-12-22 14:55
什么意思

a表有的配额没有配足，比如
单号       类别    需求数额    配额    差额
t1101     a01      500           500      0
t1102     a01      300           300      0
t1105     b01      600           600      0
t1107     b01      400           400      0
t1115     b01      800           200     -600

t1115     b01    还差600，B表在分配后为0时数据将会清空，后续B表增加数量时再次对t1115     b01 进行配额
作者: lin2003_lin    时间: 2011-12-22 15:23
Henry D. Sy 发表于 2011-12-22 14:57
先判断配额是否足够，
判断哪个？b表的剩余数量够分吗？

判断a表配额没有配足，比如
单号       类别    需求数额    配额    差额
t1101     a01      500           500      0
t1102     a01      300           300      0
t1105     b01      600           600      0
t1107     b01      400           400      0
t1115     b01      800           200     -600

那么现在的b表还是1200的话（本来已经分配完了为“0”，假设再增加1200），重新点击按钮，结果还是差600，我希望当再次点击按钮的时候，
能把600的差额分配给t1115     b01 ， b表剩余600

这样的话，当a表的b01继续增加需求，假使400，那么再次点击按钮，能继续将剩余的600分配400给新的需求



作者: lin2003_lin    时间: 2011-12-22 15:27
Henry D. Sy 发表于 2011-12-22 12:05
建议在b中增加一字段：分配后余额，用于显示实际库存
则代码调整如下：

不希望增加一字段，而是将“分配后余额”直接代替元“剩余数量”
作者: Henry D. Sy    时间: 2011-12-23 13:14
lin2003_lin 发表于 2011-12-22 15:27
不希望增加一字段，而是将“分配后余额”直接代替元“剩余数量”
  1. Private Sub Command0_Click()
  2.     Dim rs As New ADODB.Recordset
  3.     Dim rst As New ADODB.Recordset
  4.     Dim cnn As New ADODB.Connection
  5.     Dim sSQL As String
  6.     Dim lngBal As Long

  8.     Set cnn = CurrentProject.Connection

  10.     sSQL = "select  类别,剩余数量 from b"
  11.     rs.Open sSQL, cnn, adOpenKeyset, adLockOptimistic

  13.     Do While Not rs.EOF
  14.         lngBal = rs.Fields("剩余数量")
  15.         sSQL = "select * from a where 类别='" & rs.Fields("类别") & "'"
  16.         rst.Open sSQL, cnn, adOpenKeyset, adLockOptimistic
  17.         With rst
  18.             Do While Not .EOF
  19.                 If .Fields("差额") <> 0 Or lngBal <> 0 Then
  20.                     If lngBal >= Abs(.Fields("差额")) Then
  21.                         .Fields("配额") = .Fields("配额") + Abs(.Fields("差额"))
  22.                         lngBal = lngBal - Abs(.Fields("差额"))
  23.                     Else
  24.                         .Fields("配额") = .Fields("配额") + lngBal
  25.                         lngBal = 0
  26.                     End If
  27.                     .Fields("差额") = .Fields("配额") - .Fields("需求数额")
  28.                     .Update
  29.                     rs.Fields("剩余数量") = lngBal
  30.                     rs.Update
  31.                 End If
  32.                 .MoveNext
  33.             Loop
  34.             .Close
  35.         End With
  36.         rs.MoveNext
  37.     Loop
  38.     Me.a.Requery
  39.     Me.b.Requery
  40.     rs.Close
  41.     Set rs = Nothing
  42.     Set rst = Nothing
  43.     Set cnn = Nothing
  44. End Sub
复制代码
作者: Henry D. Sy    时间: 2011-12-23 13:17
[attach]47779[/attach]附件老是传不上
作者: Henry D. Sy    时间: 2011-12-23 13:23
  1. Private Sub Command0_Click()
  2.     Dim rs As New ADODB.Recordset
  3.     Dim rst As New ADODB.Recordset
  4.     Dim cnn As New ADODB.Connection
  5.     Dim sSQL As String
  6.     Dim lngBal As Long

  8.     Set cnn = CurrentProject.Connection

  10.     sSQL = "select  类别,剩余数量 from b"
  11.     rs.Open sSQL, cnn, adOpenKeyset, adLockOptimistic

  13.     Do While Not rs.EOF
  14.         lngBal = rs.Fields("剩余数量")
  15.         If lngBal <> 0 Then
  16.             sSQL = "select * from a where 类别='" & rs.Fields("类别") & "'"
  17.             rst.Open sSQL, cnn, adOpenKeyset, adLockOptimistic
  18.             With rst
  19.                 Do While Not .EOF
  20.                     If .Fields("差额") <> 0 Then
  21.                         If lngBal >= Abs(.Fields("差额")) Then
  22.                             .Fields("配额") = .Fields("配额") + Abs(.Fields("差额"))
  23.                             lngBal = lngBal - Abs(.Fields("差额"))
  24.                         Else
  25.                             .Fields("配额") = .Fields("配额") + lngBal
  26.                             lngBal = 0
  27.                         End If
  28.                         .Fields("差额") = .Fields("配额") - .Fields("需求数额")
  29.                         .Update
  30.                         rs.Fields("剩余数量") = lngBal
  31.                         rs.Update
  32.                     End If
  33.                     .MoveNext
  34.                 Loop
  35.                 .Close
  36.             End With
  37.         End If
  38.         rs.MoveNext
  39.     Loop
  40.     Me.a.Requery
  41.     Me.b.Requery
  42.     rs.Close
  43.     Set rs = Nothing
  44.     Set rst = Nothing
  45.     Set cnn = Nothing
  46. End Sub
复制代码
作者: Henry D. Sy    时间: 2011-12-23 13:24
[attach]47780[/attach]
作者: lin2003_lin    时间: 2011-12-23 16:03
Henry D. Sy 发表于 2011-12-23 13:24

谢谢

运行错误“13”

作者: lin2003_lin    时间: 2011-12-23 16:11
Henry D. Sy 发表于 2011-12-23 13:23

[attach]47783[/attach]
作者: lin2003_lin    时间: 2011-12-23 16:12
Henry D. Sy 发表于 2011-12-23 13:23

运行错误，请再帮忙看看。

万分感激！谢谢！
作者: Henry D. Sy    时间: 2011-12-23 16:19
请引用较高版本的ado
作者: lin2003_lin    时间: 2011-12-23 16:29
Henry D. Sy 发表于 2011-12-23 16:19
请引用较高版本的ado

我是用Access2003的
作者: Henry D. Sy    时间: 2011-12-23 16:34
lin2003_lin 发表于 2011-12-23 16:29
我是用Access2003的

不是指access本身的版本，而是ado
在vba编辑窗口，菜单栏里--工具--引用，选择较高的ado比如2.5
作者: Henry D. Sy    时间: 2011-12-23 16:36
  1. 引用 ADO 库
  2. 您的工程必须引用 ADO 库。

  4. 从 Microsoft Visual Basic 引用 ADO 的步骤：

  6. 在 Visual Basic 中，从“工程”菜单中选择“引用”。
  7. 从列表中选择“Microsoft ActiveX Data Objects x.x Library”。请验证至少还选择了下列库：
  8. Visual Basic for Applications
  9. Visual Basic runtime objects and procedures
  10. Visual Basic objects and procedures
  11. OLE Automation
  12. 单击“确定”。
  13. 在 Visual Basic for Applications 中使用 ADO 同样简单，下面以 Microsoft Access 为例。

  15. 从 Microsoft Access 中引用 ADO 的步骤：

  17. 在 Microsoft Access 中，从“数据库”窗口的“模块”选项卡中选择或创建一个模块。
  18. 从“工具”菜单中选择“引用”。
  19. 从列表中选择“Microsoft ActiveX Data Objects x.x Library”。请验证至少还选择了下列库：
  20. Visual Basic for Applications
  21. Microsoft Access 11.0 Object Library（或更新版本）
  22. 单击“确定”。
  23. 在 Visual Basic 中创建 ADO 对象
  24. 若要创建一个自动变量和该变量的一个对象实例，可以使用两种方法：Dim 或 CreateObject。

  26. Dim
  27. 在 Dim 中使用 New 关键字，可以只用一步就完成 ADO 对象的声明和实例化：

  29. Dim conn As New ADODB.Connection
  30. 或者，也可用两步来完成 Dim 语句声明和对象实例化：

  32. Dim conn As ADODB.Connection
  33. Set conn = New ADODB.Connection
  34. 注意   如果在工程中引用了适当的 ADO 库，则不必在 Dim 语句中显式使用 ADODB progid。但使用它可以保证避免与其他库发生命名冲突。
  35. 例如，如果您在同一个工程中既引用 ADO 又引用 DAO，则应包含一个限定符指定实例化 Recordset 对象时要使用的对象模型，如下列代码所示：
  36. Dim adoRS As ADODB.Recordset
  37. Dim daoRS As DAO.Recordset
复制代码
作者: lin2003_lin    时间: 2011-12-23 16:39
Henry D. Sy 发表于 2011-12-23 16:19
请引用较高版本的ado

需要那一个版本的ADO
我的电脑ado版本是：2.81.3012.0
作者: lin2003_lin    时间: 2011-12-23 16:42
Henry D. Sy 发表于 2011-12-23 16:19
请引用较高版本的ado

有没有其它的办法?
数据库将在多台电脑运行
运行的环境都是winXP,Access2003
作者: Henry D. Sy    时间: 2011-12-23 16:47
是我给你的附件有问题，或是你将代码贴到你自己的库，而出现问题的。
作者: lin2003_lin    时间: 2011-12-23 16:49
Henry D. Sy 发表于 2011-12-23 16:47
是我给你的附件有问题，或是你将代码贴到你自己的库，而出现问题的。

附件的问题
作者: lin2003_lin    时间: 2011-12-23 16:53
Henry D. Sy 发表于 2011-12-23 16:47
是我给你的附件有问题，或是你将代码贴到你自己的库，而出现问题的。

可以了，引用了ADO2.8！
谢谢！




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