ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2154|回复: 19

[求助] VBA如何根据付款明细表中的付款状态实现付款信息的自动化生成?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2021-10-16 11:29 | 显示全部楼层 |阅读模式

求助大神:
需求描述:根据付款登记表中【是否付款】状态为“本次付款”的,生成第二个sheet页中的本次付款明细数据;
生成规则如下:1、供应商类型为”员工“的,将同一供应商的不同单据编号合并在一个单元格内,并对行金额进行累加求和;
                      2、供应商类型为”客户“的,将同一供应商的同一单据编号的付款信息进行去重即可;
                           最终生成示例中的结果;
image.jpg
image.png

付款表.zip

62.38 KB, 下载次数: 5

TA的精华主题

TA的得分主题

发表于 2021-10-16 14:04 | 显示全部楼层
Sub 获取成绩()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim i As Long
Dim arr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheet1
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a3:v" & r)
End With
ReDim arr(1 To UBound(ar), 1 To 10)
For i = 2 To UBound(ar)
    If Trim(ar(i, 12)) = "本次付款" Then
        If Trim(ar(i, 11)) = "员工" Then
            zf = Trim(ar(i, 2)) & "|" & Trim(ar(i, 6))
            t = d(zf)
            If t = "" Then
                k = k + 1
                d(zf) = k
                t = k
                arr(k, 1) = ar(i, 13)
                arr(k, 2) = ar(i, 2)
                arr(k, 3) = ar(i, 15)
                arr(k, 4) = ar(i, 16)
                arr(k, 5) = ar(i, 17)
                arr(k, 8) = ar(i, 20)
                arr(k, 9) = ar(i, 21)
                arr(k, 10) = ar(i, 22)
            End If
            arr(t, 6) = arr(t, 6) + ar(i, 8)
            If arr(t, 7) = "" Then
                arr(t, 7) = ar(i, 19)
            Else
                arr(t, 7) = arr(t, 7) & "/" & ar(i, 19)
            End If
        ElseIf Trim(ar(i, 11)) = "客户" Then
            zf = Trim(ar(i, 2)) & "|" & Trim(ar(i, 6))
            t = d(zf)
            If t = "" Then
                k = k + 1
                d(zf) = k
                t = k
                arr(k, 1) = ar(i, 13)
                arr(k, 2) = ar(i, 2)
                arr(k, 3) = ar(i, 15)
                arr(k, 4) = ar(i, 16)
                arr(k, 5) = ar(i, 17)
                arr(k, 6) = ar(i, 18)
                arr(k, 7) = ar(i, 19)
                arr(k, 8) = ar(i, 20)
                arr(k, 9) = ar(i, 21)
                arr(k, 10) = ar(i, 22)
            End If
        End If
    End If
Next i
With Sheet2
    .UsedRange.Offset(3) = Empty
    .[a4].Resize(k, UBound(arr, 2)) = arr
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2021-10-16 14:05 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
说明文字极不严谨,代码是猜着写的,仅供参考
付款表.rar (25.32 KB, 下载次数: 1)

TA的精华主题

TA的得分主题

 楼主| 发表于 2021-10-16 15:15 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2021-10-17 14:40 | 显示全部楼层
验证问题示例描述:
1、李春茹作为员工,付款明细只有一行,金额等于付款登记表中状态为本次付款的、供应商为李春茹的所有行金额累计,凭证号就为SX2021060116/SX2021060117
2、账号在处理后变成科学计数,有什么办法可以以原格式转换过去吗?
先谢谢你的解答,麻烦了

TA的精华主题

TA的得分主题

 楼主| 发表于 2021-10-17 14:43 | 显示全部楼层
3190496160 发表于 2021-10-16 14:05
说明文字极不严谨,代码是猜着写的,仅供参考


验证问题示例描述:
1、李春茹作为员工,付款明细只有一行,金额等于付款登记表中状态为本次付款的、供应商为李春茹的所有行金额累计,凭证号就为SX2021060116/SX2021060117
2、账号在处理后变成科学计数,有什么办法可以以原格式转换过去吗?
先谢谢你的解答,麻烦了

TA的精华主题

TA的得分主题

 楼主| 发表于 2021-10-17 14:44 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2021-10-17 15:01 来自手机 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
Initiaux 发表于 2021-10-17 14:40
验证问题示例描述:
1、李春茹作为员工,付款明细只有一行,金额等于付款登记表中状态为本次付款的、供应 ...

问题一没解决?

TA的精华主题

TA的得分主题

 楼主| 发表于 2021-10-17 15:07 | 显示全部楼层
zpy2 发表于 2021-10-17 15:01
问题一没解决?

是的,截图是用上边大神提供的代码跑出来的结果,问题1没有被解决

TA的精华主题

TA的得分主题

发表于 2021-10-17 15:09 来自手机 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
Initiaux 发表于 2021-10-17 14:43
验证问题示例描述:
1、李春茹作为员工,付款明细只有一行,金额等于付款登记表中状态为本次付款的、 ...

Else
                arr(t, 7) = "'" & arr(t, 7) & "/" & ar(i, 19)

rem 第二问 这句 改一下 文本格式显示
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-22 20:07 , Processed in 0.043756 second(s), 15 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表