EXCEL跟据多个指定单元格内容用BVA复制到另一表里

爱诗利

请各位师傅帮帮忙，写BVA代码。收付凭证里的红色的内容分别保存到收付款凭证数据库里
谢谢

半百

去掉多余部分

熊文来

半百 发表于 2023-7-6 15:34
去掉多余部分

可以上传一下附件吗？

半百

熊文来 发表于 2023-7-6 17:10
可以上传一下附件吗？

代码就是楼主附件里的，只是把多余的注释掉了（绿色部分），另外修改了红色部分。

爱诗利

熊文来 发表于 2023-7-6 17:10
可以上传一下附件吗？

已上传有附件:
在两个人张图片下面的
万森制衣厂出货记录-233

爱诗利

半百 发表于 2023-7-6 19:04
代码就是楼主附件里的，只是把多余的注释掉了（绿色部分），另外修改了红色部分。

谢谢。老师，帮忙，已做好。谢谢

爱诗利

熊文来 发表于 2023-7-6 17:10
可以上传一下附件吗？

Sub 收付款凭证保存()
    Application.ScreenUpdating = False
    Dim n%, m%, x%, y%, k%
    Set sht = Sheets("收付款凭证")
    On Error GoTo 100
    If Sheets("收付款凭证数据库").[A:A].Find([M2]) = sht.[M2] Then
        MsgBox "此单已经保存过了！请重新开单"
    Else
100:
        If [D3] = "" Or [M3] = "" Then MsgBox "信息没有填写完整，不能保存！": End
        m = Sheets("收付款凭证数据库").[A65536].End(xlUp).Row + 1
        With Sheets("收付款凭证数据库")
                    .Cells(m, "A").Value = [M2] '编号
                    .Cells(m, "B").Value = [J2] '日期
                    .Cells(m, "C").Value = [D3] '客户名称
                    .Cells(m, "D").Value = [I3] '联系人
                    .Cells(m, "E").Value = [M3] '收付类型
                    .Cells(m, "F").Value = [C4] '收款事由
                    .Cells(m, "G").Value = [M5] '收款金额
                    .Cells(m, "H").Value = [M6] '收付方式
                    .Cells(m, "I").Value = [B6] '备注
                    
        End With
        MsgBox "提交收付款凭证保存成功！"
    End If
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
End Sub