VBA如何根据付款明细表中的付款状态实现付款信息的自动化生成？

Initiaux

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

3190496160

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

3190496160

说明文字极不严谨，代码是猜着写的，仅供参考
付款表.rar (25.32 KB, 下载次数: 1)

2021-10-16 14:05 上传

点击文件名下载附件

Initiaux

我试试，先谢谢你

Initiaux

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

Initiaux

3190496160 发表于 2021-10-16 14:05
说明文字极不严谨，代码是猜着写的，仅供参考

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

Initiaux

这个是问题图示

zpy2

Initiaux 发表于 2021-10-17 14:40
验证问题示例描述：
1、李春茹作为员工，付款明细只有一行，金额等于付款登记表中状态为本次付款的、供应 ...

问题一没解决？

Initiaux

zpy2 发表于 2021-10-17 15:01
问题一没解决？

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

zpy2

Initiaux 发表于 2021-10-17 14:43
验证问题示例描述：
1、李春茹作为员工，付款明细只有一行，金额等于付款登记表中状态为本次付款的、 ...

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

rem 第二问 这句 改一下 文本格式显示