Excel vba 实例(16) - 按指定字段分类批量提取内容

今天分享的一个实例是：按指定字段分类批量提取内容。

问题描述

这个是之前帮一个网友朋友解决的问题，可能其他朋友也会有相同的需求。

也不知道概况的是否准确，参考下面这个例子吧：

因为是作为实例讲解，故简单化了一下，数据只截取了一小部分。实际数据可能会有几百上千条。

如上图所示，要求把表一中相同单据号的内容都填入表二当中，最后的效果就是单据尾号004的一行信息填一张表，005的两条信息及006的三条信息各填一张表。

下面是效果图

思路

1、对单据号做个简单的排序，无论是按升序或者降序排列都可以，目的就是把相同单号的排在一起，方便做后续的处理。这一步是手工操作即可。 2、VBA程序的思路：每条信息都循环一遍，从最后一条开始，如果当前信息与上一条相同，则把该条信息复制到表二中去；如果当前信息与上一条不相同，则复制该条信息到 表二，把单号填入到表二的表头，然后保存文件。

核心代码如下：

IfCells(i,Col)<>Cells(i-1,Col)Then'如果和上一行单据号不一样了
Range("D"&i&":I"&i).CopySheet2.Range("A"&count)'复制当前单据号及内容到出单表
Range("B"&i).Copy
Sheet2.Range("B2").PasteSpecialxlPasteValues'填写好单号
'保存出单表，名字为单据号
Sheet2.Copy
ActiveWorkbook.SaveAsFilename:=MyBook.Path&"\"&Range("B"&i),FileFormat:=xlNormal'将工作簿另存为EXCEL默认格式
ActiveWorkbook.Close

Sheet2.Range("A5:F31").ClearContents
Sheet2.Range("B2").ClearContents
count=5

ElseIfCells(i,Col)=Cells(i-1,Col)Then'如果下一行单据号和上一行一样
Range("D"&i&":I"&i).CopySheet2.Range("A"&count)'复制当前单据号及内容到出单表
count=count+1

效果演示

测试了一下，那位朋友的约700条记录，大约2-3分钟就可以搞定，非常的省事。

如果需要源文件的话，wx公号后台回复「实例16」即可。

如果还有其他需要定制化的功能，也可以联系我。

欢迎交流！