求支招，最好是成品，VBA加工清单，打印好后自动保存信息到另一工作表汇总

menfei1989

制作清单打印保存.rar (156.8 KB, 下载次数: 22)

2018-6-11 01:48 上传

点击文件名下载附件
请按模板支招

我做2周都没做成，代码老不对。求大神做成，万分感谢，

lsc900707

欢迎新人！
分明找代工，还什么支招。呵呵。

一指禅62

同意3楼观点，整理了一下，我自以为简洁一点，供参考：

1. 
   
2. Sub 保存记录()
   
3.     Dim Rng As Range, xID As String
   
4.     Sheet1.Select
   
5.     If Range("H9") = 0 Then Exit Sub    '合计金额为0，不保存
   
6.     Rem  工单号作为关键字，必须检查！！！
   
7.     If Trim(Range("H2")) = "" Then
   
8.         MsgBox "编号不能为空值!请重新指定!", vbCritical, "工单编号"
   
9.         Exit Sub
   
10.     End If
    
11.     xID = Trim(Range("H2"))
    
12.     Set Rng = Sheet2.Range("B:B").Find(xID, lookat:=xlWhole)
    
13.     If Not Rng Is Nothing Then
    
14.         MsgBox "所指定的编号已存在!请重新指定!", vbCritical, "错误工单号"
    
15.         Exit Sub
    
16.     End If
    
17.    
    
18.     Rem  保存数据
    
19.     Dim i%, j%, a(), n%
    
20.     For i = 4 To 8
    
21.         If Range("I" & i) <> 0 Then
    
22.             n = n + 1: ReDim Preserve a(1 To 13, 1 To n)
    
23.             a(1, n) = Range("F2") '日期
    
24.             a(2, n) = xID         '编号
    
25.             a(3, n) = Range("B2") '客户
    
26.             a(13, n) = Range("B9") '备注
    
27.             For j = 1 To 9
    
28.                 a(j + 3, n) = Cells(i, j)
    
29.             Next
    
30.         End If
    
31.     Next
    
32.     Sheet2.Range("A65536").End(3).Offset(1, 0).Resize(n, 13) = WorksheetFunction.Transpose(a)
    
33. End Sub

复制代码

menfei1989

lsc900707 发表于 2018-6-11 05:38
欢迎新人！
分明找代工，还什么支招。呵呵。

我是找不到这方面的大神，不得已才出此下策，求大神帮帮忙做个完整的VBA，谢谢，定酬谢