|
用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,如下
|
|