遇到VBA的应用1：从整体中挑选出某一类别的所有个体
索引号：VBAeg001
封面来自chrome插件Momentum
上一次正经地写一篇教程，还是在2018年7月底的时候了，一方面是因为没什么主题可写，另一方面还是因为我比较懒。不过我今天忍着胃疼以及鱼刺卡在喉咙去医院急诊也没取出来的疼痛中写下这篇文章，也算是稍微有那么一点努力了吧。
言归正传，我最近在工作中刚好碰到了一个需求，恰逢昨天有同学提问，于是写下此文。
文章的标题是《从整体中挑选出某一类别的个体》，可能从字面来理解，这不就是筛选功能吗？
我要说明的是：我们要达成的目标的确是根据特定条件筛选出这一类别的所有数据，但是我们要做的是以下两点：
(1)在随时更换条件的情况下，使用简单的快捷键达成效果或者按一个按钮就出结果；
(2)结果的展示要么是将原始数据中的相关数据高亮展示(即所谓的highlight)，要么是直接输出到新的表格里面。
显然采用简单的筛选功能是不可能达成上面两个诉求的，必须借助VBA的神秘力量。
关于VBA的所有内容请参考我的总结文章：VBA系列：结束与开始。
本文所用的Excel工作簿的链接如下：
链接：https://pan.baidu.com/s/1YoUb2jrgt23tRH8Ve317fQ
提取码：jt4d
主要内容一览
本期主要包括以下三个方面的内容：
原始数据的“编造”与分析(涉及数据透视表的内容)、需求描述
以高亮(填充颜色/highlight)的形式展示结果
将按照某条件筛选出来的结果复制到另外的工作表中
原始数据的“编造”与分析、需求描述
一、原始数据的“编造”与分析
本部分涉及的知识点：(请点击相关链接补课)
randbetween函数
mid函数
choose函数(这个函数之前好像没提过，大家可以去Excel帮助里面看看帮助文件)
用&连接两个部分的内容
round函数
排序功能
每个日期都有对应的某个数字：Excel的1900年时间系统
数据透视表：基础、高级
PS：以前的文章的排版是真的惨不忍睹。(我猜这行你们注意不到，哈哈哈；注意到请联系我。)
为了写这篇文章，我特地编写了400余家公司的信息(原始数据工作簿中的客户信息工作簿)，包含的信息较少，只有三个，分别是客户编号、客户名称和联系方式三个信息。
其中客户编号采用6226001001、6226001002、6226001003然后下拉的方式填充生成；客户名称是从某一文件的公司列表中随便取的两个字，然后在后面加上“公司”二字生成的；手机号码采用这个公式生成：
=choose(randbetween(1,10),131,132,133,135,136,137,153,156,189,170)&randbetween(12500023,68219071)
如果这样生成的手机号码能打通，纯属巧合，不过按照道理来说，有那么几个能打通，亦非怪事。
然后在这404家公司信息的基础上，又编写了5000条往来交易数据，遇到的一个困难是如何将5000条记录分配到404家公司，我用的方法是利用randbetween(1,404)函数生成的辅助数据，然后粘贴成值，升序排列之后，将404家公司的信息导入整体数据工作表内；
然后继续采用round函数和randbetween函数的嵌套生成了以千为单位的进账和出账金额，然后计算往来净额(进账-出账)；
接下来又遇到分配往来日期的问题，也就是给每一条往来交易数据设置一个单独的日期，我计划将这些日期分配在2018年1月1日至2018年3月31日之间。由于日期格式本质上也是一个数值型数据，说得更通俗一点就是个数字，其中2018年1月1日是43101，2018年3月31日是43190。那么，又到了randbetween发挥作用的时间了。
最后排序，得出这样的整体数据。
说起来，这是我第一次讲述怎么去编一堆数据来应对举例的需要，其实在我之前的文章中，除了标注过数据来源的之外，其他出现的所有数据都是我采用一定手段现编现造的。
拿到这样的一堆数据之后，如果想统计一个每个月每个公司的往来净额应该怎么办呢？那就需要用到数据透视表了。(大家可以参考之前写的数据透视表的两篇文章：基础、高级)
在本文的这个数据透视表中，需要对日期按月进行组合，关于数据透视表中组合的相关内容在这篇文章里面：基础数据透视表。
具体过程我就不赘述了，最终结果是这样的。
二、需求描述
讲完了怎么编数据，对数据做了个简单的数据透视之后，让我们来看看本文的核心诉求，假设存在这样一个情形：让你给这里面的部分公司打电话核对交易流水信息。如何才能根据某一个公司名字，来快速得获得某一家公司的所有交易流水呢？
展示方式可以是：(1)在整体数据工作表中高亮(填充底色/highlight)出相关数据；(2)将整体数据中的这些数据复制到新的工作表中。
实现方式可以是：(1)给宏设置快捷键/指定按钮，然后使用快捷键/按按钮来调用宏；(2)采用工作表事件，自动调用某个宏。
组合起来应该有4种情况，但是由于采用工作表事件来highlight不太具有现实意义，就被我给否决了；而工作表事件来复制数据，会导致循环引用，从而报错，所以也不考虑。最后其实就2种情况。
真要用工作表事件的话，其实也简单，使用Worksheet_SelectionChange即可，关于工作表事件可以参考这篇文章：VBA第七课：事件与响应。
以高亮(填充颜色/highlight)的形式展示结果
假设我们需要找的30个客户如“highlight形式”工作簿中的“个体”工作表所示。
我们要做的是在“整体数据”工作表内highlight出所选中的某家公司的交易信息，并跳转到该公司所有交易数据的最后一行。
我的思考逻辑是这样的：
(1)如何确定在“个体”工作表中所选中的单元格代表的客户名称，如果选中A列中的单元格，就可以直接读取客户名称信息；那如果选中的是B列、C列或其他列呢？显然这就需要额外的考虑；同时，所选单元格不能读取不了客户名称(不能没有对应的A列数据)，否则程序会陷入崩溃。这就需要一个if...then...end if的判断；
(2)知道了所需要的找的是那一家公司之后，怎么去“整体数据”工作表内找到这家公司的数据呢？答案几乎是唯一的，那就是for...next循环嵌套if...then...end if语句来一个个判断。
(3)使用for...next循环后，该循环内的循环语句和判断语句要达到的目标就是将找出的那一行给highlight显示，这就需要使用到Range对象的Interior.Color属性，以常见的标黄为例，需要将该属性的值设置为65535.
(4)标黄之后，怎么定位到highlight出来的最后一行的某个单元格中呢？(这样做的理由是可以直接看到我们要找的数据，否则不定位的话，还得满世界找黄底的那几行)这一步的做法是在if...then...end if判断语句中记录符合条件的行号，然后在程序最后选择那一行，或者那一行的某个特定单元格。
(5)上面都写完之后，又出现一个新的问题，随着运行次数的增加，填充黄色底色的行越来越多，整张表都是黄底，那就没有意义了，所以在sub过程一开始的时候，要将原来的单元格格式清除，我这里采用的是粗暴的方法，也就是Cells.ClearFormats。这一操作会将所有格式都清除，不仅包括底色，还包括字体、单元格边框之类的属性。
(6)写完sub过程(宏)之后，给代码指定快捷键或按钮。
把逻辑捋清楚之后，写代码就比较简单了，代码如下：
Sub highlight()
Dim rng, rng0, rng1, a
Sheets("整体数据").Cells.ClearFormats '这一行对应思考逻辑的第(5)步
Sheets("个体").Select
rng0 = Selection.Row
rng1 = Sheets("个体").Cells(rng0, 1) 'rng0和rng1这两行反映的是思考逻辑第(1)步中提到的选择B列、C列内单元格的情况
' rng1 = Selection '只用这一行反映的是思考逻辑第(1)步中提到的选择A列单元格的情况
If rng1 <> 0 Then
Sheets("整体数据").Select
'这一行的目的是明确下一行中Range("C:C")所代表的C列的具体含义，如果没有这一行就需要将下一行中的Range("C:C")改为Sheets("整体数据").Range("C:C")
For Each rng In Range("C:C")
If rng = rng1 Then
Rows(rng.Row).Interior.Color = 65535
a = rng.Row '记录符合判断条件的单元格的行号
End If
Next
Sheets("整体数据").Cells(a, "F").Select '选中highlight的最后一行中的往来净额数据
End If
End Sub
写完代码之后，指定快捷键或按钮，就很简单了。
(1)指定快捷键：开发工具选项卡→代码功能区→宏功能→选项→指定快捷键。
(2)指定按钮：开发工具选项卡→控件功能区→插入功能→表单控件→选第一行最左边的按钮→给按钮指定宏。
写完代码之后，指定快捷键或按钮，就很简单了。大家可以将附件下载下来自己试一试ctrl+q的快捷键，或者点一下“个体”工作表中的那个按钮1。
将按照某条件筛选出来的结果复制到另外的工作表中
继续沿用上一部分的那30家公司，现在我们要做的是将上一部分标黄的那些行给复制到“个体”工作表中。
这里的思考逻辑可以继续沿用上一部分的步骤(1)和步骤(2)，但是需要对后续的内容进行修改，对步骤(1)也要进行限定。
这部分的思考逻辑如下：
(1)如何确定在“个体”工作表中所选中的单元格代表的客户名称，限定只能选中A列中的单元格，因为选中其他单元格的话，无法直接应用到工作表事件里面去，会出现随便选个单元格就运行一遍程序的尴尬局面。同时，所选单元格不能读取不了客户名称(不能选择没数据的A列单元格)，否则程序会陷入崩溃。这就需要在最外面嵌套一层if...next的循环。
(2)知道了所需要的找的是那一家公司之后，怎么去“整体数据”工作表内找到这家公司的数据呢？答案几乎是唯一的，那就是for...next循环嵌套if...then...end if语句来一个个判断。
(3)使用for...next循环后，该循环内的循环语句和判断语句要达到的目标就是将找出的那一行复制到“个体”工作表中，而且为了防止函数的影响，必须采用选择性粘贴。其实我也不知道选择性粘贴的代码是怎么写，这谁记得住啊？我的做法是自己录制一个类似的选择性粘贴的宏，然后去分析那些是我需要的，然后直接拿来使用。(录制的宏可以参看对应附件的模块2内的代码)
(4)复制一行之后，还要继续往下复制，这就意味着在循环体内就必须有一行是a = a+1；
(5)把某一家公司的交易数据全部都复制完之后，我们最好还是能够重新选回之前所选择的那个单元格。这就需要在程序的开始继续所选择的那个单元格的行号，然后在程序最后定位到那个初始单元格。
(6)与上一部分类似，复制之后，数据越来越多，也要想办法把原来的数据都清除。我选择的是清除C2：J1000单元格的数据，而不是直接清除C到J列，因为那样会将标题也给清除。
(7)写完sub过程(宏)之后，可以将它指定给快捷键/按钮，步骤与上一部分类似。
代码是这样的：
Sub copydata()
Dim rng, rng0, a, sr
Sheets("个体").Range("C2:J1000").Clear '将个体工作表中之前复制出来的结果给清除掉，不能直接清除C到J列，那样的话，标题就没了
Sheets("个体").Select
If Selection.Column = 1 And Selection.Value <> 0 Then '这一判断语句限制了只能选中A列，选中其他列不会有结果；也限制了空值的问题
rng0 = Selection.Value
sr = Selection.Row '记录最开始选中的单元格的行号
Sheets("整体数据").Select
a = 2 '从个体工作表的C2单元格开始粘贴
For Each rng In Range("C:C")
If rng = rng0 Then
Range(Cells(rng.Row, "B"), Cells(rng.Row, "I")).Select
Selection.Copy
Sheets("个体").Select
Cells(a, "C").Select
' ActiveSheet.Paste '原版本，下面这行是选择性粘贴成值，防止函数的引用错误
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("整体数据").Select '必须要重新选回整体数据这个工作表，否则只能复制第一行数据
a = a + 1 '自动往下一行粘贴
End If
Next
Sheets("个体").Select
Cells(sr, "A").Select '最后选回最初选中的单元格
End If
End Sub
总结与扩展
在内涵方面，这个例子可以用标题来概括，即从整体中挑选出某一类别的所有个体。可以拓展到昨天我同学举的那个挑选某个行业的例子，当然还有很多其他的应用，就看你们怎么理解了。
在操作层面，还可以拓展成复选框形式的VBA代码；或者在复制到一个全新的工作表(非整体数据、个体工作表)的时候采用工作表事件的形式来自动实现。
最后，又睡晚了，科学防脱有难度。
晚安。
以上。
1142
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
