|
本帖最后由 todaynew 于 2009-5-26 20:00 编辑
38216
rainless_9 发表于 2009-5-26 13:17
Private Sub 拆分_Click()
Dim rs As New ADODB.Recordset
Dim sql1 As String, sql2 As String
Dim i As Long, m As Long, n As Long
Dim x As Double, y As Double, Q As Double, r As Double
Q = 999999.99
sql1 = "select * from 订单明细 where 单号='" & Me.单号.Value & "'"
rs.Open sql1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
sql2 = "DELETE * FROM 临时表"
CurrentDb.Execute sql2
For i = 1 To rs.RecordCount
If rs("金额") > Q Then
m = Int(rs("金额") / Q)
r = Round(rs("金额") / (m + 1), 2)
x = rs("数量")
y = rs("金额")
For n = 1 To m
sql2 = "INSERT INTO 临时表 ( 单号, 名称, 单位, 数量, 金额 ) "
sql2 = sql2 & "VALUES ('" & rs("单号") & "','" & rs("名称") & "','" & rs("单位") & "'," & Round(rs("数量") * r / rs("金额"), 0) & "," & r & ")"
CurrentDb.Execute sql2
x = x - Round(rs("数量") * r / rs("金额"), 0)
y = y - r
Next
sql2 = "INSERT INTO 临时表 ( 单号, 名称, 单位, 数量, 金额 ) "
sql2 = sql2 & "VALUES ('" & rs("单号") & "','" & rs("名称") & "','" & rs("单位") & "'," & x & "," & y & ")"
CurrentDb.Execute sql2
Else
sql2 = "INSERT INTO 临时表 ( 单号, 名称, 单位, 数量, 金额 ) "
sql2 = sql2 & "VALUES ('" & rs("单号") & "','" & rs("名称") & "','" & rs("单位") & "'," & rs("数量") & "," & rs("金额") & ")"
CurrentDb.Execute sql2
End If
rs.MoveNext
Next
Me.临时子窗体.Form.Requery
rs.Close
End Sub |
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|