发货单自动保存

一只狗三只眼

各位晚上好：
发货单中信息点保存后自动保存至流水记录中！
发货单自动记录.zip (16.52 KB, 下载次数: 71)

2016-6-3 21:47 上传

点击文件名下载附件

不胜感谢！

simon5412

赋值罢了，没什么难度，自己写呗

simon5412

多看看别人的帖子，总有一个适合你
http://club.excelhome.net/thread-1281634-1-1.html

hzruziniu

1. '===============清空开票生成编号
   
2. Private Sub CommandButton1_Click()
   
3.     Dim n1&, n2&, no&, i&, w$
   
4.     Range("b6,b7,b8,a10:j12") = ""
   
5.     With Sheets("流水记录")
   
6.         i = .Range("a65536").End(3).Row
   
7.         n1 = Month(Date)
   
8.         n2 = Month(.Range("b" & i))
   
9.         If n1 > n2 Or i = 1 Then
   
10.             no = 1
    
11.             Else
    
12.             no = Right(.Range("a" & i), 3) + 1
    
13.         End If
    
14.         w = Year(Date) & Format(Month(Date), "00") & Format(Day(Date), "00") & Format(no, "000")
    
15.     End With
    
16.     Range("j5") = w
    
17.     Range("j7") = Format(Date, "yyyy年mm月dd日")
    
18. End Sub
    
19. 
    
20. '=================保存到数据库
    
21. Private Sub CommandButton2_Click()
    
22.     Dim arr, brr(), n&, i&, r&, j&, k&
    
23.     n = Application.CountA(Range("a10:a11"))
    
24.     arr = Range("a10:i" & 9 + n)
    
25.     With Sheets("流水记录")
    
26.         k = .Range("a65536").End(3).Row
    
27.         i = k + 1
    
28.         Set c = .Range("a:a").Find(Range("j5"), , , , , 1)
    
29.         If Not c Is Nothing Then
    
30.              MsgBox "该收据已存在不能重复保存。"
    
31.             Exit Sub
    
32.         End If
    
33.         If Range("b6") = "" Or Range("b7") = "" Then
    
34.              MsgBox "发货单位、客户名称不能为空。"
    
35.             Exit Sub
    
36.         End If
    
37.         If Range("a10") = "" Or Range("f10") = "" Or Range("g10") = "" Or Range("h10") = "" Then
    
38.              MsgBox "数据填写不完整。"
    
39.             Exit Sub
    
40.         End If
    
41.         ReDim brr(1 To n, 1 To 11)
    
42.         For r = 1 To UBound(arr)
    
43.             j = j + 1
    
44.             brr(j, 1) = Range("j5")
    
45.             brr(j, 2) = Format(Range("j7"), "yyyy-mm-dd")
    
46.             brr(j, 3) = Range("b6")
    
47.             brr(j, 4) = Range("b7")
    
48.             brr(j, 5) = Range("b8")
    
49.             brr(j, 6) = arr(r, 1)
    
50.             brr(j, 7) = arr(r, 3)
    
51.             brr(j, 8) = arr(r, 4)
    
52.             brr(j, 9) = arr(r, 5)
    
53.             brr(j, 10) = arr(r, 6)
    
54.             brr(j, 11) = arr(r, 9)
    
55.         Next
    
56.         k = .Cells(65536, 1).End(3).Row + 1
    
57.         .Cells(k, 1).Resize(j, 11) = brr
    
58.     End With
    
59.     MsgBox "OK！保存成功！"
    
60. End Sub
    

复制代码

hzruziniu

发货单自动记录.rar (23.78 KB, 下载次数: 84)

2016-6-4 00:44 上传

点击文件名下载附件

请看附件

一只狗三只眼

hzruziniu 发表于 2016-6-4 00:44
请看附件

发货编号日期不能跟着发货日期走。例发货日期2016060800*，发货编号也要2016060800*，须要一致。编号：发货日期加单据顺序号

一只狗三只眼

hzruziniu 发表于 2016-6-4 00:44
请看附件

发货编号日期不能跟着发货日期走。例发货日期2016060800*，发货编号也要2016060800*，须要一致。编号：发货日期加单据顺序号

hzruziniu

一只狗三只眼 发表于 2016-6-4 06:22
发货编号日期不能跟着发货日期走。例发货日期2016060800*，发货编号也要2016060800*，须要一致。编号：发 ...

给你修改一下：
1、打开工作表默认生成当天日期，并根据当天日期编号
2、修改J7的日期，编号自动调整为修改的日期
3、清空填表默认为J7的日期并编号
请看附件 发货单自动记录.rar (29.12 KB, 下载次数: 92)

2016-6-4 10:35 上传

点击文件名下载附件

mrsnow

hzruziniu 发表于 2016-6-4 00:44
请看附件

这位高人，正在找这样的表格呢，谢谢了。

hzruziniu

mrsnow 发表于 2016-6-4 10:52
这位高人，我想请问一下，这个只能保存2行的数据呢，如果要保存比如20行的话，那该怎办呢？我觉得还是很 ...

要增加行次主要是修改下面二句代码   
n = Application.CountA(Range("a10:a11"))
    arr = Range("a10:i" & 9 + n)
第一句的n计算出表格内共填几行，a10:a11只有二行，如果需要把表格增加行数，填20行就是a10:a29，你填表格时可以在这个表格的行范围内任意填多少行，n自动计算出行数。
第二句的arr 是动态数组，从 i 的第9行开始再加上第一句算出的n行，如果n是满表格20行，则 i 列的下最后行是9+20=29行，也就是从a10开始到 i29 这样一个柜形数组范围，根据这个数组范围内可任意填写几行就算几行。 数组 arr 的大小是= Range("a10:i29" )