如何对两列总和相同的数字进行对应拆分分摊？

作者：绿色风分类：时间：2022-08-17 浏览：127

楼主
wcymiss

Q：每个人的实发金额总计=每个工程的工程金额总计，如何实现一一对应，就是每个人实发金额需要摊到每个工程金额里面？如图所示。

A：代码如下：

Sub test2()
Dim Arr, Arr2, Result, N&, I&, D#
Arr = [a1].Resize(Columns(1).Find("汇总").Row, 2).Value
Arr2 = [d1].Resize(Columns(4).Find("汇总").Row, 2).Value
ReDim Result(1 To 4, 1 To 1)
N = LBound(Arr) + 1: I = LBound(Arr2) + 1
Do While N < UBound(Arr) And I < UBound(Arr2)
D = WorksheetFunction.Min(Arr2(I, 2), Arr(N, 2))
Result(1, UBound(Result, 2)) = Arr(N, 1)
Result(2, UBound(Result, 2)) = D
Result(3, UBound(Result, 2)) = Arr2(I, 1)
Result(4, UBound(Result, 2)) = D
If Arr(N, 2) - Arr2(I, 2) > 0 Then
Arr(N, 2) = Arr(N, 2) - Arr2(I, 2)
I = I + 1
ElseIf Arr(N, 2) - Arr2(I, 2) < 0 Then
Arr2(I, 2) = Arr2(I, 2) - Arr(N, 2)
N = N + 1
Else
N = N + 1
I = I + 1
End If
ReDim Preserve Result(1 To 4, 1 To UBound(Result, 2) + 1)
Loop
[a9].Resize(UBound(Result, 2), UBound(Result)) = Application.Transpose(Result)
End Sub

实发金额.rar

2楼
亡者天下

过来学习一下

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表