[已解决]五金仓库系统代码之入出库单据提交

hannanrenjie · 发表于 2013-8-4 17:39

本帖最后由 hannanrenjie 于 2013-8-4 18:07 编辑

我的五金仓库管理系统中的代码，多数是各位高手帮忙写了自己根据实际工作表改的。少数自己录制。
写在这里供老师们提出建议，并作备忘。顺便混点学币

单据提交是在入库、出库单据在打印之后，将数据写入“月数据”表中。
这个IIF语句太好了，省了不少麻烦。不记得是哪位老师帮忙写的，太感谢他了。
注释掉的“到货与入库”几句是同时将数据写入“到货与入库表”中的。

Sub 入库提交新()
Dim a As Long
a = IIf(Sheets("入库单").[P14] = "", Sheets("入库单").[P14].End(xlUp).Row, 14)
Range("C5:W" & a).Select
Selection.Copy
Sheets("月记录").Visible = True '显示数据库表
Dim b As Long
b = Sheets("月记录").[B65536].End(xlUp).Row + 1
Sheets("月记录").Select
Sheets("月记录").Cells(b, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SelectedSheets.Visible = False '隐藏月记录表
Dim c As Long
<font color="red"> 'c = Sheets("到货与入库").[B65536].End(xlUp).Row + 1
'Sheets("到货与入库").Select
'Sheets("到货与入库").Cells(c, 1).Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False</font>
Sheets("入库单").Select
Range("P5:P14") = ""
Range("N3").Select
MsgBox "任杰提醒您：随时保存哦！"
End Sub

复制代码

Sub 出库提交新()
Dim a As Long
a = IIf(Sheets("出库单").[U14] = "", Sheets("出库单").[U14].End(xlUp).Row, 14)
Range("C5:W" & a).Select
Selection.Copy
Sheets("月记录").Visible = True '显示表
Dim b As Long
b = Sheets("月记录").[a65536].End(xlUp).Row + 1
Sheets("月记录").Select
Sheets("月记录").Cells(b, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SelectedSheets.Visible = False '隐藏表
Sheets("出库单").Select
Range("U5:U14") = ""
Range("W5:W14") = ""
MsgBox "任杰提醒您：随时保存哦！"
End Sub

复制代码

最佳答案

月排行榜 / 总排行榜

zjdh

2013-8-6 18:41

用这段语句就避免了你说的问题：

Sub 入库提交新()
Dim B%, R&
Application.EnableEvents = False '禁止触发事件
B = IIf(Range("P14") = "", Range("P14").End(xlUp).Row, 14)
With Sheets("月记录")
R = .Range("A65536").End(xlUp).Row + 1 '月记录未行的下一行
Range("C5:W" & B).Copy '复制数据
.Cells(R, 1).PasteSpecial Paste:=xlPasteValues '选择性粘贴(数据)
End With
Application.CutCopyMode = False '取消剪切模式
Range("P5:P14") = ""
Range("N3").Select
Application.EnableEvents = True '允许触发事件
MsgBox "任杰提醒您：随时保存哦！"
End Sub

复制代码

跳转到最佳答案楼层

hannanrenjie · 发表于 2013-8-4 17:49

旧入库代码也作个对比，以后学时好参照。
与上面新代码的区别在于：没有判断入库数量区域是否有数据。导致单据打印范围以外的辅助信息，要经常清除和重写公式。

Sub 入库提交() '旧入库代码
Dim a As Long
a = Sheets("入库单").[a1].End(xlUp).Row
Range("C5:S14").Select
Selection.Copy
Sheets("数据库").Visible = True '显示数据库表
Dim b As Long
b = Sheets("数据库").[a65536].End(xlUp).Row + 1
Sheets("数据库").Select
Sheets("数据库").Cells(b, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'ActiveWindow.SelectedSheets.Visible = False '隐藏数据库表
Sheets("入库单").Select
Range("F6:F14") = ""
Range("M5:M14") = ""
End Sub

复制代码

Sub 出库提交()
Dim a As Long
a = Sheets("出库单").[a1].End(xlUp).Row
Range("C5:S14").Select
Selection.Copy
Sheets("数据库").Visible = True '显示数据库表
Dim b As Long
b = Sheets("数据库").[a65536].End(xlUp).Row + 1
Sheets("数据库").Select
Sheets("数据库").Cells(b, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'ActiveWindow.SelectedSheets.Visible = False '隐藏数据库表
Sheets("出库单").Select
Range("C6:E14") = ""
Range("F6:G14") = ""
Range("R5:R14") = ""
End Sub

复制代码

danysy · 发表于 2013-8-4 18:04

好代码，值得学习

zjdh · 发表于 2013-8-4 19:27

本帖最后由 zjdh 于 2013-8-6 18:37 编辑

帮你简化一下罗嗦的语句
看7楼帖子

hannanrenjie · 发表于 2013-8-4 20:08

zjdh 发表于 2013-8-4 19:27
帮你简化一下罗嗦的语句
Sub 入库提交新()
Dim B As Long

谢谢！
能否在后面注释一下，语句的意思！都是别人写的，我是全不懂的。

原来的变量A不用了？
有一点就是格式也复制过去了。入库单中有些地方着色了的。

hannanrenjie · 发表于 2013-8-4 20:26

另外，还要请教个问题：
单步时从下面 Range("P5:P14") = "" 这句跳到另外一个模块中，然后又回来了。
那个代码在“入库单”表中。
下面红字的地方是我做的记号。它这是在干什么啊？
原来的那个代码也这样跳。

Private Sub worksheet_Change(ByVal Target As Range) '跳到这里
aaa = Target.Row
bbb = Target.Column '跳到下面
If aaa = 4 And bbb = 6 Then

ListBox1.Visible = True
Static Yz As String
Dim HZSR As Boolean
a = UCase(Trim([f4]))
If a = Yz Then Exit Sub
ListBox1.Clear
Yz = a
If LenB(StrConv(StrConv(a, vbNarrow), vbFromUnicode)) <> Len(StrConv(a, vbNarrow)) Then
HZSR = True
      Else
   HZSR = False
      End If
If HZSR Then
For Each aa In Range("A2:A" & [a65536].End(xlUp).Row)
   If InStr(UCase(CStr(aa.Value)), a) <> 0 Then
         ListBox1.AddItem aa.Value
   End If
Next aa
End If
If Not HZSR Then
For Each aa In Range("A2:A" & [a65536].End(xlUp).Row)
   If InStr(PINYIN(CStr(aa.Value)), a) <> 0 Then
   ListBox1.AddItem aa.Value
End If
Next aa
End If
End If '跳回入库提交代码去了
End Sub

zjdh · 发表于 2013-8-6 18:18

1.  有格式、有颜色就凭你原来提供的语句是无从知晓的。
2.  那是触发了Change事件，你原来提供的语句中未提到此内容。
3.  你应该发附件上来，才可能全面了解情况，作出完善的处理。

zjdh · 发表于 2013-8-6 18:41

用这段语句就避免了你说的问题：

Sub 入库提交新()
Dim B%, R&
Application.EnableEvents = False '禁止触发事件
B = IIf(Range("P14") = "", Range("P14").End(xlUp).Row, 14)
With Sheets("月记录")
R = .Range("A65536").End(xlUp).Row + 1 '月记录未行的下一行
Range("C5:W" & B).Copy '复制数据
.Cells(R, 1).PasteSpecial Paste:=xlPasteValues '选择性粘贴(数据)
End With
Application.CutCopyMode = False '取消剪切模式
Range("P5:P14") = ""
Range("N3").Select
Application.EnableEvents = True '允许触发事件
MsgBox "任杰提醒您：随时保存哦！"
End Sub

复制代码

hannanrenjie · 发表于 2013-8-6 21:55

本帖最后由 hannanrenjie 于 2013-8-6 21:59 编辑

zjdh 发表于 2013-8-6 18:41
用这段语句就避免了你说的问题：

代码没有（触发了Change事件？）跳出去，又跳回来了。也是选择性粘贴数值了。
太感谢了！如果能给两个最佳就好了！

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

[已解决]五金仓库系统代码之入出库单据提交

相关帖子