海量数据分摊，求助大神帮忙

nihao123456789

[tr] [/tr]
[tr] [/tr]
[tr] [/tr]
[tr] [/tr]
[tr] [/tr]
[tr] [/tr]
[tr] [/tr]

拆分条件
1.查询《数据源》表每一行数据
2.如果“条件”列，为“A”时。则拆分该行。按比例拆分（《拆分条件》表“C列“，保留整数，分摊后合计数不能有差），并删除原行，拆分结果放入《结果》表中
3.如果“条件”列，为“B”时，则将同一个”编号“列的所有行按"数据"列求和。如果求和结果小于20万，不拆分这些行（就是不进行任何操作），如果求和结果大于等于20万，则拆分该行。按比例拆分（《拆分条件》表“C列“，保留整数，分摊后合计数不能有差），并删除原行，拆分结果放入《结果》表中
	举例：
	《数据源》第二行，条件为"A",所以我需要将”数据“行的”1439“这个值进行拆分，拆分成10行（按比例），导入《结果》表
	《数据源》第五行，条件为"B",对应编号为"BH00150"，我将所有"BH00150"且条件为"B"的”数据“行进行汇总（结果为200087），因为200087大于20万，所以这些行需要全部进行拆分，每行数据都拆分成10行（按比例），导入《结果》表，并删除《数据源》表中原来的行

hugo_huang

简单看了一下您的数据，实现起来应不算难，问题在于，当通过4舍5入的方式得到的整数之和与源数有差异的时候，调整哪个数？第1个？最小的？还是随意？

nihao123456789

hugo_huang 发表于 2018-5-4 15:02
简单看了一下您的数据，实现起来应不算难，问题在于，当通过4舍5入的方式得到的整数之和与源数有差异的时候 ...

第一个吧。数据量大。关键我只会简单的VBA。运行的时候很卡。实际数据有10万左右。且项目可能不一定是10个。一般在1-20个之间浮动。

hugo_huang

这个问题用Power Query解起来比较简单，通过几个步骤的操作，结合List.Transform函数做一下数据转换即可，我用Power Query简单做了一个，步骤不多，如下图所示：
其中的一些步骤可以按需要进行整合一下，不过目前这个拆分也还比较快，4万行数据拆成22万多，也就几秒钟。

附件里的数据我删了大部分，因为源数据拆分后再压缩仍有13M多，上传不了。您先参考一下。

wdx223

hugo_huang 发表于 2018-5-4 17:58
这个问题用Power Query解起来比较简单，通过几个步骤的操作，结合List.Transform函数做一下数据转换即可， ...

思路不错，学习了，厉害

天道酬勤y

条件为"B",对应编号为"BH00150"，我将所有"BH00150"且条件为"B"的”数据“行进行汇总 汇总哪一列（还是全部列） 你要问人家要说清楚啊

天道酬勤y

hugo_huang 发表于 2018-5-4 17:58
这个问题用Power Query解起来比较简单，通过几个步骤的操作，结合List.Transform函数做一下数据转换即可， ...

我把数据改为大于20万，条件为"B"的”数据“行进行汇总大于20万的好像没拆分

天道酬勤y

符合条件的B 如果是2行数据，会拆成11行 不知道是不是这样

天道酬勤y

天道酬勤y 发表于 2022-3-12 16:28
符合条件的B 如果是2行数据，会拆成11行 不知道是不是这样

Askinofblue

用SqlCel函数解决这个问题的具体过程如下：

'使用SqlCel数据必写这一句
Public Function s() As Object
    Set s = Application.COMAddIns("SqlCelAddIn").Object
End Function

Sub 拆分()
    Dim q As Variant  '数据源
    Dim tj As Variant  '匹配条件
    Dim c1 As Variant '符合第一个条件的拆分
    Dim c2 As Variant '符合第二个条件的拆分
    Dim tp As Variant '临时数据集
    Set q = s.rngtoqax(Sheets("数据源").Range("A1").CurrentRegion, True)   '读取数据源
   
    '获取第一个拆分的数据集
    Set c1 = s.qaxselect(q, "条件='A'")
    Set tj = s.rngtoqax(Sheets("拆分条件").Range("A1:D11"), True)
    Set c1 = s.qaxjoin(c1, tj, Array("a.*", "b.比例"), "a.辅助=b.辅助", "inner")
    Set c1 = s.qaxupdate(c1, "a_拆分数据=a_拆分数据*b_比例", "")
   
    '获取大于200000的编号
    Dim bh As Variant
    Set bh = s.qaxsum(q, "拆分数据", "编号")
    Set bh = s.qaxselect(bh, "SUM_拆分数据>200000")
   
    '获取第二个拆分的数据集
    Set c2 = s.qaxselect(q, "条件='B'")
    Set c2 = s.qaxjoin(c2, bh, Array("a.*"), "a.编号=b.编号", "inner")
    Set c2 = s.qaxjoin(c2, tj, Array("a.*", "b.比例"), "a.a_辅助=b.辅助", "inner")
    Set c2 = s.qaxupdate(c2, "a_a_拆分数据=a_a_拆分数据*b_比例", "")
   
    '从原数据集中根据序号剔除掉两个拆分的数据集获得不需要拆分的数据集
    Set tp = s.getcols(c1, False, Array("a_序号"))
    Set tp = s.qaxdistinct(tp, "a_序号")
    Set q = s.qaxjoin(q, tp, Array("a.*", "b.a_序号"), "a.序号=b.a_序号", "left")
    Set q = s.qaxselect(q, "b_a_序号 is null")
   
    Set tp = s.getcols(c2, False, Array("a_a_序号"))
    Set tp = s.qaxdistinct(tp, "a_a_序号")
    Set q = s.qaxjoin(q, tp, Array("a.*", "b.a_a_序号"), "a.a_序号=b.a_a_序号", "left")
    Set q = s.qaxselect(q, "b_a_a_序号 is null")
   
    '将3个数据集写入Excel结果表
    With Sheets("结果")
    s.qaxtorng2 c1, .Range("a1"), True  '写入第一个拆分的数据集
    s.qaxtorng2 c2, .Range("a1048576").End(xlUp).Offset(1, 0), False  '写入第二个拆分的数据集
    s.qaxtorng2 q, .Range("a1048576").End(xlUp).Offset(1, 0), False   '写入不需要拆分的数据集
    End With
End Sub

匹配出来40万行，也就是每一条记录都需要匹配10行。
代码全程运行20-30秒。
附运行结果
由于最大只能上传2M文件，所以结果只保留了20行数据。

注意附件中添加了两个辅助字段，字段名都是辅助，值都为1，如下