库存进出登记管理

bb75308973 · 发表于 2012-3-22 14:00

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,自己试哈哈
      切换到汇总表自动更新,可以实时了解哪些东西有变动但是没更改库存的
      其它....

来个附件 :

nethycf · 发表于 2012-3-22 15:33

谢谢楼主的分享、收下了。

a4521448 · 发表于 2012-5-20 21:26

想要这个格式，，，没金币咋整？楼主可以教一下我怎么做个库存表不？QQ413418914

mapsi · 发表于 2012-7-12 07:53

谢谢分享谢谢{:261:}

qindao4 · 发表于 2012-7-12 15:31

支持一下！确实不错的呵呵呵！

w498375470 · 发表于 2012-8-29 21:55

好东西收藏一定要顶起

遗憾 · 发表于 2012-10-17 17:03

谢谢分享谢谢

百变丁丁 · 发表于 2012-10-17 17:17

谢谢楼主分享，学习一下！

xiheduo2012 · 发表于 2012-11-3 15:16

学习下

gstsygj · 发表于 2012-11-22 09:05

想学习，求教qq476180499

		自动登录	找回密码
密码			注册

库存进出登记管理

本帖子中包含更多资源