微信公众号:yhjbox(永恒君的百宝箱),获取最新文章、资源。

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

Excel VBA 实例 永恒君 2329℃ 0评论

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

问题描述

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

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

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

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

下面是效果图

思路

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

核心代码如下:

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

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

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

效果演示

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

如果需要源文件的话,微信公众号后台回复「实例16」即可。

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

欢迎交流!

微信公众号:永恒君的百宝箱

个人博客:www.yhjbox.com

转载请注明:永恒君的百宝箱 » Excel vba 实例(16) – 按指定字段分类批量提取内容

喜欢 (1)
发表我的评论
取消评论

*

code

表情