根据出库单的内容自动保存到发货明细里

hzruziniu

1. 根据单据编号奇数和偶数判断生成二种不同底色。
   
2. Sub 保存()
   
3.     Dim arr(), x&, i&, j&, r&
   
4.     x = Application.WorksheetFunction.Max(Range("A7:A12"))
   
5.     ReDim arr(1 To x, 1 To 8)
   
6.     For i = 1 To x
   
7.         arr(i, 1) = Range("f3")
   
8.         arr(i, 2) = Date
   
9.         arr(i, 3) = Range("b3")
   
10.         For j = 2 To 6
    
11.             arr(i, j + 2) = Cells(i + 6, j)
    
12.         Next
    
13.     Next
    
14.     With Sheets("成品出库明细")
    
15.         MsgBox x
    
16.         r = .Range("a65536").End(3).Row + 1
    
17.         .Cells(r, 1).Resize(x, 8) = arr
    
18.         MsgBox 1 * Right(Range("f3"), 3) Mod 2
    
19.         
    
20.         If 1 * Right(Range("f3"), 3) Mod 2 = 0 Then '如果末3位是偶数
    
21.             '.Cells(r, 1).Resize(x, 8)).Interior.Color = RGB(0, 0, 255)    '三基色方法底色蓝色
    
22.            .Cells(r, 1).Resize(x, 8).Interior.ColorIndex = 34  '底色浅青色"
    
23.         Else
    
24.             .Cells(r, 1).Resize(x, 8).Interior.ColorIndex = 24  '底色冰蓝
    
25.         End If
    
26.     End With
    
27.     MsgBox "保存成功！"
    
28. End Sub
    

复制代码

月关

Sub 保存()
Set fd = Sheets("成品出库明细").Columns(1).Find([f3])
If Not fd Is Nothing Then MsgBox "单据编号已存在": Exit Sub
Set x = Sheets("成品出库明细").[a4].End(4)
y = x.Interior.ColorIndex
r = x.Row
arr = Range([b7], [b7].End(4).End(2))
Dim brr(1 To 1, 1 To 3)
brr(1, 1) = [f3]
brr(1, 2) = Format([g5] & [i5], "yyyy/m/d")
brr(1, 3) = [b3]
With Sheets("成品出库明细").Cells(r + 1, 1)
.Resize(UBound(arr), 3) = brr
.Offset(, 3).Resize(UBound(arr), 6) = arr
.Resize(UBound(arr), 8).Interior.ColorIndex = IIf(y = 19, 24, 19)
End With
Union([f3], Range([b7], [b7].End(4).End(2))).ClearContents
End Sub


注意事项：
你的成品出库明细表里，格式太乱，不可见的乱七八糟的东西太多，所以没法从A列最后一个单元格倒着往上查找最后一行录入数据。
所以我是从A4单元格往下查找，这就导致一个潜在的问题：
如果你是第1次录入，也就是A4单元格往下都是空的，复制过来的数据不知道会出现在下面什么地方（因为你有不可见的格式设定），解决办法是随便在A5单元格里输入一个数据，完事把这行删除就行了。
再就是，如果成品出库明细中间出现空行，复制过来的数据会从空行开始覆盖下面已有的数据，当然从你的格式上看一般这种情况不大可能发生。

你最后说的这个反向查询，在哪里查？你的发货明细在哪里？

月关

又在审核…… 头疼……
最后加了一句数据复制到出库明细后清空出库单上的内容和单据编号，不需要的话就把最后一句删掉

月关

忘说了，正常还应该加一个保存时如果单据为空的弹窗提示，你注意点就行了 ^)^

开心就好tzl

月关 发表于 2019-8-24 15:26
Sub 保存()
Set fd = Sheets("成品出库明细").Columns(1).Find([f3])
If Not fd Is Nothing Then MsgBo ...

就是根据发货明细反向生成一个出库单，

开心就好tzl

hzruziniu 发表于 2019-8-24 14:53

谢谢！谢谢大神！

月关

开心就好tzl 发表于 2019-8-24 16:37
就是根据发货明细反向生成一个出库单，

根据成品出库明细，"生成" 出库单 ？
奇怪了，看11#生用 end(3)，刚才试了下又可以了…… 写代码那会儿怎么测试都错

开心就好tzl

月关 发表于 2019-8-24 16:42
根据成品出库明细，"生成" 出库单 ？
奇怪了，看11#生用 end(3)，刚才试了下又可以了…… 写代码那会儿 ...

大神在不？我发现代码有一些小的问题,第一、当入库单的内容只有一条发货信息时点保存后，“成品出库明细表”保存的信息会出现很多条信息。第二、保存后的“成品出库明细表”单价问啥会显示“#N/A”C:\Documents and Settings\Administrator\桌面

killq

想长期用建议还是重新设计下表格，采用ado，如果有必要，先转成access数据库试用
如果只是短期应付一下无所谓，毕竟没有多少数据嘛

月关

开心就好tzl 发表于 2019-8-25 13:23
大神在不？我发现代码有一些小的问题,第一、当入库单的内容只有一条发货信息时点保存后，“成品出库明细 ...

简单，图省事而已的结果，出去玩了，周一修。
而且我想起来怎么更好的处理颜色的问题了，当然，也许是更坏的