库存进出登记管理
Sub 变更登记()'定义变量
Dim app As New Application
Dim bd As Workbook, kc As Workbook
Dim mx As Worksheet, kcmx As Worksheet
Dim n As Integer, i As Integer
Dim bdsl As Integer, x As Integer, y As Integer
Dim msg, a
'前处理
a = InputBox("输入密码以获得权限", "密码")
If a <> "123" Then Exit Sub
app.Visible = False
Application.AutomationSecurity = msoAutomationSecurityForceDisable
'变量赋值
Set kc = Workbooks.Open(ThisWorkbook.Path & "\库存明细表.xlsm")
If kc.ReadOnly = True Then
Application.DisplayAlerts = False
kc.Close
Application.DisplayAlerts = True
MsgBox "库存明细表当前以只读方式打开,请检查后重试!"
Exit Sub
End If
Set bd = ThisWorkbook
Set mx = bd.Sheets("明细")
Set kcmx = kc.Sheets(1)
bd.Activate
n = Range("A65536").End(xlUp).Row
msg = "明细表中不存在此产品,请手动增加后重试!"
'错误处理
On Error Resume Next
'数据更新
For i = 6 To n
If Range("I" & i) <> "已变更" Then
If Not kcmx.Range("A:A").Find(Range("A" & i).Value, , , xlWhole) Is Nothing Then
bdsl = Range("C" & i) - Range("D" & i)
x = kcmx.Range("A:A").Find(Range("A" & i).Value, , , xlWhole).Row
kcmx.Range("G" & x) = kcmx.Range("G" & x) + bdsl
Range("I" & i) = "已变更"
Else
msg = msg & Chr(10) & Range("A" & i).Value
End If
End If
Next
'保存退出
On Error GoTo 0
Application.DisplayAlerts = False
kc.Save
kc.Close
Application.DisplayAlerts = True
'弹窗提示没有的型号
If msg <> "明细表中不存在此产品,请手动增加后重试!" Then
MsgBox msg
End If
End Sub说明:库存明细表不需要手动更改,全是登记表中
登记表中输入名称可以调用型号,输入型号可以调用名称
如果没有是入不了库的
密码三个:123, 456, 789,自己试哈哈
切换到汇总表自动更新,可以实时了解哪些东西有变动但是没更改库存的
其它....
来个附件 :
谢谢楼主的分享、收下了。 想要这个格式，，，没金币咋整？楼主可以教一下我怎么做个库存表不？QQ413418914 谢谢分享谢谢{:261:} 支持一下！确实不错的呵呵呵！ {:1_1:}好东西收藏一定要顶起 谢谢分享谢谢 {:1_1:} 谢谢楼主分享，学习一下！ 学习下{:1_1:}{:1_1:}{:1_1:}{:1_1:}{:1_1:} {:1_1:}{:1_1:}{:1_1:}{:1_1:}想学习，求教qq476180499