【84期】特殊拆分工作表—拆分工作表数据到工作簿或Access数据库

wpxxsyzx

三种方法写到一个工作簿了。

oyzhjr

上附件，里面有三个工作表，分别是转到ACCESS的，转到工作薄的。
转到工作蒲中的去除重复项07支持，03只好用高级筛选了。

panan123_0

再交一个，只为不失分。也不知道犯规了没有

onthetrip2008

年底了，事情多，有空再试试用普通方法以及access能否做出来。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
在EH学到了很多知识，新年快到了，在这里感谢EH各位坛友和老师，提前祝各位新年快乐，更上一层楼。
---------
修改了一下,重新上传

wcymiss

panan123_0

zhaogang1960 发表于 2011-12-22 13:37
没有追究重发，是算法违反了“常规法和ADO法不得混用”的规定：
    If Dir(sPath & WbName) = "" Then
...

其实版主已经宽宏大量了，AOD法贴上去。就提示我犯规了。
后来查了下能用into添加表和工作簿的。后来也不好意思改了。
就是常规法 扣了一分实属自己不严谨。加个日期排序就完善了。
就是我太想3分了。以后努力

Simon_Zhu

接上

当时觉得：哎哟，难点出来了。

于是仔细研究数据源2.xls的数据规律，结合赵版的题目要求（以“送货单位”和“商品编号”为关键字，如果有重复，按照“日期”字段只取最新的一个纪录）

日期	送货单位	商品编号	商品名称	单位	单价	数量	金额
2011 10 19	D公司	0284	家乐菌菇汁	支	12.00	111.00	1332.00
2011 10 31	A公司	0284	家乐菌菇汁	支	24.00	123.00	2952.00
2011 11 19	D公司	0284	家乐菌菇汁	支	12.00	111.00	1332.00
2011 11 22	A公司	0284	家乐菌菇汁	支	15.00	114.00	1710.00
2011 11 25	A公司	0284	家乐菌菇汁	支	18.00	117.00	2106.00
2011 11 28	A公司	0284	家乐菌菇汁	支	21.00	120.00	2520.00
2011 12 1	A公司	0284	家乐菌菇汁	支	24.00	123.00	2952.00

判断出是以送货单位为关键字，与上行数据的送货单位做比较，不重复的保留，重复的取最大日期的记录；

得出难点在如何剔除数据源2.xls中红色部分的数据。

当时心想：哇，难，这题目有深度，不愧是竞赛题，用常规法不是很难，难在用ADO法去解决，心想既然是竞赛题，那就挑战难的吧，说不定能获得赵版所说的 精彩答案另加分。

（不信你试着做做用ADO法读取数据源2.xls得到表效果二）

苦苦思索，不断测试，终于想到用错位序号解决与上行数据做比对去重复的难题，如下：

‘================================================

'为符合条件的数据加上序号，1为起始数

Sql = "Select b.日期,b.送货单位,b.商品编号,(Select count(1) from [Sheet1$]as a Where a.商品编号=b.商品编号 and a.日期<=b.日期 ) as 排名 from [Sheet1$] as b Where 商品编号='0284'"

'为符合条件的数据加上错位序号，2为起始数

Sql1 = "Select b.日期,b.送货单位,b.商品编号,(Select count(1)+1 from [Sheet1$]as a Where a.商品编号=b.商品编号 and a.日期<=b.日期 ) as 排名 from [Sheet1$] as b Where 商品编号='0284'"

'利用错位序号,得出要剔除的日期

Sql = "Select b.日期 from (" & Sql & ") as a Left Join (" & Sql1 & ") as b on a.排名=b.排名 and a.送货单位=b.送货单位"

'去除空值

Sql = "Select * from (" & Sql & ") Where 日期 is not null "

'得出最终结果

Sql = "Select a.* from [Sheet1$] as a Left Join (" & Sql & ") as b on a.日期=b.日期  Where b.日期 is null and 商品编号='0284'"

'把最终结果写入相应文件

Sql = "Select *  into [Excel 8.0;Database=" & FilesPath & "记录2.xls].[0284] FROM (" & Sql & ")"

'执行

Cnn.Execute (Sql)

‘================================================

做完后有点沾沾自喜的感觉，威严的想到：蛮难的，不过我还是做出来了，咳，关于那个精彩答案另加分￥@%@……@#￥…

谁知事实情况是： 你知道的。

在赵版公布得分结果，未公布答案时，

我一头雾水：将参赛选手的代码一一测试了一遍，他们没有完成读取数据源2.xls得到表效果二的效果呀？（常规法除外），只有我一人做出了这种效果，技术水平又上升了？还是自作多情了？…

到赵版公布答案，汗了，没有技术上升，是自作多情了，把问题想复杂了。

昨晚赵版发我的消息：

谢谢答题，对“判断“纪录”工作簿是否存在，如果不存在就新建一个”理解不正确，如果存在则不需要删除，结果只能有一个“纪录”工作簿

额，对于这个我不郁闷，条件判断没写好，因为这不是技术难点，郁闷的是自以为完成了用ADO法得到以送货单位为关键字，与上行数据的送货单位做比较，不重复的保留，重复的取最大日期的记录的技术难点，事实却是驴唇不对马嘴，严重审题不清…

求安慰…这个，有没有安慰技术分一说 ##$!@$$@%^$#&^&，hehe.

请以我为戒，那个审题啊要正确。

感谢赵版带来如此精彩的题目与答案。

期待下一期。

另：感谢赵版帮我删除了重复粘贴的代码，帖子发完了我就没敢修改，怕违规，hehe。感谢！

Simon_Zhu

兄弟姐妹们，我冤啊，好不好。

严重审题不清，我以为是这样：

以商品编号0284 为例

代码读取数据源1.xls 应该得到 记录(新建时执行数据源1效果).xls 这样的效果，如下表：

日期	送货单位	商品编号	商品名称	单位	单价	数量	金额
2011 10 19	D公司	0284	家乐菌菇汁	支	12	111	1332
2011 10 31	A公司	0284	家乐菌菇汁	支	24	123	2952

（表效果一）

代码读取数据源2.xls 应该得到记录2(执行数据源2效果).xls 这样的效果，如下表：

日期	送货单位	商品编号	商品名称	单位	单价	数量	金额
2011 10 19	D公司	0284	家乐菌菇汁	支	12	111	1332
2011 10 31	A公司	0284	家乐菌菇汁	支	24	123	2952
2011 11 19	D公司	0284	家乐菌菇汁	支	12	111	1332
2011 12 1	A公司	0284	家乐菌菇汁	支	24	123	2952

（表效果二）

没有想到是新建及追加记录，而是以为分别读取2个数据源文件分别得到各自的记录文件。

按着我这样的思路往下继续，

当我用代码   

arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Cnn.Execute("Select Distinct 商品编号 from [Sheet1$]").GetRows))

For i = 1 To UBound(arr)

Sql = "Select *  into [Excel 8.0;Database=" & FilesPath & "记录.xls].[" & arr(i) & "] FROM [Sheet1$] where 日期 in(Select Max(日期) as 日期 from [Sheet1$] Group by 送货单位)  and 商品编号='" & arr(i) & "' "

Cnn.Execute (Sql)

Next

去读取数据源1.xls的时候， 得到正确效果，如（表效果一），当时觉得：还可以，不是很难吗。这次可以灌到点技术分了。

但读取数据源2.xls的时候，得出的却是下表

日期	送货单位	商品编号	商品名称	单位	单价	数量	金额
2011 11 19	D公司	0284	家乐菌菇汁	支	12	111	1332
2011 12 1	A公司	0284	家乐菌菇汁	支	24	123	2952

没有获得（表效果二）的效果。

下续

wcymiss

原来直接select into 就可以新建工作簿和工作表，学习了。

panan123_0

常规法 我是有点不妥。加个按日期排序代码就妥当了。其实我做的时候就想到了，哎为这扣了一分。我想答案对就完事了。
SQL法犯规了。无话可说。