修改的进销存无法应用

love3228

我从论坛里下载了个进销存，按照我的要求去修改，结果数据录不了。不知为何原因。请大师们指教！谢谢！

方漠

可以了. 改动的地方已经帮你标红了.

Sub 录入数据()
Application.ScreenUpdating = False
If Range("K4") = "入库" Then
    x = 1
    Do While Not (IsEmpty(Sheets("入库").Cells(x, 2).Value))
        x = x + 1
    Loop
    '入库单的行数据统计
    n = x
    z = 6
    With Sheets("单据录入")
        Do While Not (IsEmpty(.Cells(z, 2).Value))
            z = z + 1
        Loop
        For k = 5 To z - 1
                Sheets("入库").Cells(x, 1) = .Cells(2, 5)  '入库单号码
                Sheets("入库").Cells(x, 2) = .Cells(2, 3) '入库日期
                Sheets("入库").Cells(x, 3) = .Cells(k, 2)  '物品代码
                Sheets("入库").Cells(x, 4) = .Cells(k, 3)  '物品名称
                Sheets("入库").Cells(x, 5) = .Cells(k, 4)  '规格
                Sheets("入库").Cells(x, 6) = .Cells(k, 5)  '数量
                Sheets("入库").Cells(x, 7) = .Cells(k, 6)  '总重量
            x = x + 1
        Next k
    End With
    m = x - n
    MsgBox "您已向“入库”中加入了" & m & "条记录，请在“入库”中进行确认！"
ElseIf Range("K4") = "出库" Then
    y = 1
    Do While Not (IsEmpty(Sheets("出库").Cells(y, 2).Value))
        y = y + 1
    Loop
    '出库单的行数据统计
    n = y
    z = 5
    With Sheets("单据录入")
        Do While Not (IsEmpty(.Cells(z, 2).Value))
            z = z + 1
        Loop
        For k = 5 To z - 1
                Sheets("出库").Cells(y, 1) = .Cells(2, 5)  '出库单号码
                Sheets("出库").Cells(y, 2) = .Cells(2, 3) '出库日期
                Sheets("出库").Cells(y, 3) = .Cells(k, 2)  '物品代码
                Sheets("出库").Cells(y, 4) = .Cells(k, 3)  '物品名称
                Sheets("出库").Cells(y, 5) = .Cells(k, 4)  '规格
                Sheets("出库").Cells(y, 6) = .Cells(k, 5)  '销售数量
                Sheets("出库").Cells(x, 5) = .Cells(k, 4)  '总重量
            y = y + 1
        Next k
    End With
    m = y - n
    MsgBox "您已向“出库”中加入了" & m & "条记录，请在“出库”中进行确认"
End If
End Sub

方漠

已帮你测试并完善了一些列的对应.



有个缺点,出库时没有检查在仓的库存够不够出库,意即某物品在仓库存只有80了,出库100系统也不会有警示信息弹出来.需要手工检查以防止负库存出现. 可以自己优化一下,把这个检查功能加进去.