发两段代码，大家研究研究！
代码功能：计算库存，保存出入库数据
实现思想：表中记录零件代号、入库数、出库数、结余数，每笔出入库都记录当前库存。
目前存在的问题：以前库存计算都正常，但最近有时出现库存计算错误。没有任何规律可循。如下表
ID 零件代号 日期 入库数量 出库数量 结余数量
718281703002022 2006-11-28 00:00:00.000.0000.00002424.0000
761652703002022 2007-01-11 00:00:00.000NULL1000.00001424.0000
781405703002022 2007-01-30 00:00:00.000NULL1000.0000424.0000
782364703002022 2007-01-31 00:00:00.000NULL440.0000-16.0000
782373703002022 2007-01-31 00:00:00.000NULL560.0000-576.0000
782396703002022 2007-01-31 00:00:00.000NULL1000.0000-2176.0000 此笔错误
782727703002022 2007-01-31 00:00:00.0001560.0000NULL-616.0000
782728703002022 2007-01-31 00:00:00.0003409.0000NULL2793.0000
附源代码：
'添加入库单据内容（批量入库）
Private Sub AddviewOrderin()
On Error GoTo err:
Dim ctl As Control
Dim cnn As New Connection
Dim rec As New ADODB.Recordset
Dim srec As ADODB.Recordset
Dim rec1 As New ADODB.Recordset
Dim rec3 As ADODB.Recordset
Dim irow, icol As Integer
Dim str, strpart As String
Dim mtlstore As Double
Dim safehstore As Double
cnn.ConnectionString = pcnstr
cnn.Open
cnn.BeginTrans '开始事务
rec.Open "select * from tbcgorderin ", cnn, adOpenDynamic, adLockOptimistic
'添加
For irow = 1 To fpin.MaxRows
fpin.Row = irow
fpin.Col = 1
strpart = fpin.Text
If fpin.Text <> " " Then
rec.AddNew
rec.Fields( "合同号 ") = txt合同号
rec.Fields( "日期 ") = Date
rec.Fields( "记录 ") = Trim(PUser)
Set srec = cnn.Execute( "select 最高库存 from tbmaterial where 编码= ' " & strpart & " ' ")
If Not srec.EOF Then
safehstore = IIf(IsNull(srec!最高库存), 0, srec!最高库存) '最高库存
End If
rec1.Open "select * from tbcgorderin where 零件代号= ' " & strpart & " ' order by ID ", cnn, adOpenStatic, adLockReadOnly
If Not rec1.EOF Then
rec1.MoveLast
mtlstore = rec1.Fields( "结余数量 ") '上次仓库操作结余数量
Else
mtlstore = 0
End If
rec1.Close
'仓库出库内容
For icol = 1 To 11
If icol <> 2 And icol <> 3 And icol <> 4 Then
fpin.Col = icol
fpin.Row = 0
str = fpin.Text
fpin.Row = irow
rec.Fields(str) = IIf(Trim(fpin.Text) = " ", Null, Trim(fpin.Text))
End If
Next
fpin.Col = 6
rec.Fields( "结余数量 ") = mtlstore + fpin.Text '计算结余数量
'----------计算仓库入库是否满足当前库存管理要求
If mtlstore + fpin.Text > safehstore Then
MsgBox "零件 " & strpart & "的入库数量已超出了允许的最高库存. ", , "提示 "
End If
rec.Update
End If
Next
rec.Close
MsgBox "保存成功。 "
cnn.CommitTrans
cnn.Close
Set rec = Nothing
Set rec1 = Nothing
Set cnn = Nothing
Exit Sub
err:
MsgBox err.Description
Exit Sub
End Sub
逐笔入库
Private Sub cmdsave_Click()
On Error GoTo err:
Dim cnn As New Connection
Dim rec As New ADODB.Recordset
Dim ctl As Control
Dim mtlstore As Double
Dim laststore As Double '上笔结余
Dim safehstore As Double
Dim srec As New ADODB.Recordset
If Trim(txt记录) <> " " And Trim(txt记录) <> Trim(PUser) Then
MsgBox "你不能更改别人的单据。 "
Exit Sub
End If
If Trim(txt合同号) = " " Or Trim(txt检验批号) = " " Or Trim(txt零件代号) = " " Or IIf(Trim(txt入库数量) <> " ", txt入库数量, 0) = 0 _
Or IIf(Trim(txt入库重量) <> " ", txt入库重量, 0) = 0 Or Trim(txtIQC编号) = " " Then '验证输入完整性
MsgBox "记录输入不完整，请重新输入。 ", , "提示 "
Exit Sub
End If
If Validpart = False Then Exit Sub '验证合同合法性(不合法则退出)
Set rec = PGcnn.Execute( "select locked from tbmaterial where 编码= ' " & Me.txt零件代号 & " ' ") '设置零件编辑标志
If rec!Locked = 1 Then
MsgBox "另一用户正在操作该零件的库存记录，请稍后操作. "
Exit Sub
Else
Set rec = PGcnn.Execute( "update tbmaterial set locked=1 where 编码= ' " & Me.txt零件代号 & " ' ")
End If
cnn.ConnectionString = pcnstr
cnn.Open
cnn.BeginTrans '开始事务
srec.Open "select 最高库存 from tbmaterial where 编码= ' " & txt零件代号 & " ' ", cnn, adOpenStatic, adLockOptimistic
If Not srec.EOF Then '求最高库存
safehstore = IIf(IsNull(srec!最高库存), 0, srec!最高库存)
End If
If Eflg = False Then '添加
txt日期 = Date
txt记录 = Trim(PUser)
rec.Open "select * from tbcgorderin where 零件代号= ' " & txt零件代号 & " ' order by ID ", cnn, adOpenStatic, adLockOptimistic
If Not rec.EOF Then '求当前零件结余数量
rec.MoveLast
mtlstore = rec.Fields( "结余数量 ")
Else
mtlstore = 0
End If
If mtlstore + txt入库数量 > safehstore Then
MsgBox "该零件的入库数量已超出了允许的最高库存. "
End If
rec.AddNew
For Each ctl In Me.Controls
If Mid(ctl.Name, 1, 3) = "txt " Then
rec.Fields(Right(ctl.Name, Len(ctl.Name) - 3)) = IIf(ctl <> " ", ctl, Null)
End If
Next
rec.Fields( "结余数量 ") = mtlstore + txt入库数量
rec.Update
rec.Close
MsgBox "保存成功! "
Else '修改
If MsgBox( "你确定要修改该单据吗? ", vbYesNo, "提示 ") = vbNo Then Exit Sub
rec.Open "select * from tbcgorderin where ID= " & IDflg, cnn, adOpenStatic, adLockOptimistic
mtlstore = rec!入库数量 - txt入库数量
If rec.EOF Then Exit Sub
If rec.Fields( "结余数量 ") - mtlstore > safehstore Then
MsgBox "该零件的入库数量已超出了允许的最高库存. "
End If
For Each ctl In Me.Controls
If Mid(ctl.Name, 1, 3) = "txt " Then
rec.Fields(Right(ctl.Name, Len(ctl.Name) - 3)) = IIf(ctl <> " ", ctl, Null)
End If
Next
laststore = rec.Fields( "结余数量 ") - mtlstore
rec.Fields( "结余数量 ") = rec.Fields( "结余数量 ") - mtlstore
rec.Update
rec.Close
rec.Open "select * from tbcgorderin where ID> " & IDflg & " and 零件代号= ' " & txt零件代号 & " ' order by ID ", cnn, adOpenStatic, adLockOptimistic
If Not rec.EOF Then
Do Until rec.EOF
rec!结余数量 = laststore + IIf(IsNull(rec!入库数量) = True, 0, rec!入库数量) - IIf(IsNull(rec!出库数量) = True, 0, rec!出库数量)
laststore = laststore + IIf(IsNull(rec!入库数量) = True, 0, rec!入库数量) - IIf(IsNull(rec!出库数量) = True, 0, rec!出库数量)
rec.MoveNext
Loop
End If
rec.Close
MsgBox "保存成功! "
End If
cnn.CommitTrans
cnn.Close
Set rec = Nothing
Set srec = Nothing
Set cnn = Nothing
Eflg = True
Set rec = PGcnn.Execute( "update tbmaterial set locked=0 where 编码= ' " & Me.txt零件代号 & " ' ")
frmmain.Adodc1.Refresh
If Not frmmain.Adodc1.Recordset.EOF Then
frmmain.Adodc1.Recordset.MoveLast
End If
frmmain.Adodc2.Refresh
frmmain.fpordercontrol.Col = 17 '标志ID列
frmmain.fpordercontrol.Row = frmmain.fpordercontrol.DataRowCnt
IDflg = IIf(frmmain.fpordercontrol.Text = " ", 0, frmmain.fpordercontrol.Text)
Exit Sub
err:
MsgBox err.Description
Set rec = PGcnn.Execute( "update tbmaterial set locked=0 where 编码= ' " & Me.txt零件代号 & " ' ")
Exit Sub
End Sub
[解决办法]
你的代码太多太乱 1条sql就能解决一条插入也不用这么多
2数据库出现了null这个在计算当中是很危险的
[解决办法]
你的代码是多用户同时操作的吗 有可能是并发问题
