求老师帮忙修改一下表格，VBA代码

xinqingox

老师们好，帮忙用VBA完善一下表格，记录按钮所用的VBA代码不完善，不好用，使用起来不是很方便，并且不能实现出库日期和客户名称自动复制过去，而且公式有点多，反应有点慢，求老师帮忙看看，修改一下代码，谢谢！

要求：在出库单里录入出库数据（出库数据提前在数据表格里录入），录入完毕后点击记录按钮后，刚刚录入的出库数据自动保持到出库汇总表里，每次点击记录后数据都按顺序保持到出库汇总里，记录项目包括（出库日期、商品名称、规格/型号、单位、数量、单价、金额、生产批号、生产日期、效期、生产厂家、收货单位）

leirongqin

上次的文件我看了，看半天感觉速度慢不是你点记录的原因，是你出库单里面预制的公式有点多，我怎么就感觉你交代好出库单需要的格式和数据来源，让老师给你写个VBA什么的不比你公式强吗？你的那个点击记录只是把出库单内容复制到汇总那边。。。我并不认为这个速度会慢

xinqingox

leirongqin 发表于 2022-12-28 09:29
上次的文件我看了，看半天感觉速度慢不是你点记录的原因，是你出库单里面预制的公式有点多，我怎么就感觉你 ...

是的老师，我也是刚刚接触VBA，还不是很明白，自己在慢慢摸索学习中，这个表格慢是因为公式太多导致的，使用中很是不方便，箱请老师帮帮忙用VBA改一改，谢谢！

LIUZHU

有一个问题没解决好，就是按钮点多了会造成重复录入

shiruiqiang

虽然不知道你要做什么，但是思路可以：循环a列，如果arr(x,1)="客户名称:" and  arr(x,2)<>"" 的情况下，offset的值也<>“”的情况下一个一个加进去到数组brr

582766

附件请参考

xinqingox

582766 发表于 2022-12-28 10:13
附件请参考

谢谢老师，想要的就是这个结果

3190496160

Sub 保存数据()
Dim ar As Variant
Dim arr()
Dim rng As Range
With Sheets("出库单")
    ar = .Range("a1:m10")
    dh = .[k3]
End With
ReDim arr(1 To 5, 1 To 18)
For i = 6 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        n = n + 1
        arr(n, 1) = n
        arr(n, 2) = ar(4, 11)
        arr(n, 3) = ar(3, 11)
        arr(n, 4) = ar(3, 2)
        arr(n, 5) = ar(4, 2)
        For j = 1 To 13
            arr(n, j + 5) = ar(i, j)
        Next j
    End If
Next i
If n = "" Then MsgBox "出库单为空，请先录入数据！": End
With Sheets("出库汇总")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    Set rng = .Range("c1:c" & rs).Find(dh, , , , , , 1)
    If Not rng Is Nothing Then MsgBox dh & "数据已经录入，不能重复录入！": End
    .Cells(rs, 1).Resize(n, UBound(arr, 2)) = arr
End With
MsgBox "保存完毕！"
End Sub

xinqingox

582766 发表于 2022-12-28 10:13
附件请参考

老师好，还是不成，出库单第二行有数据就不成了，出库单有五行，比一定都有数据，有可能就一行，有可能两三行，有可能五行都有，麻烦老师再帮忙看看，谢谢！

3190496160

出库记录.rar (151.93 KB, 下载次数: 6)

2022-12-28 10:29 上传

点击文件名下载附件