vb表格控件

您所在的位置：网站首页 › 按照人名拆分表格 › vb表格控件

vb表格控件

2024-07-06 10:44| 来源: 网络整理| 查看: 265

这是POINT小数点的第 339 篇文章

点点写在前面：

之前我们有分享过一个场景1：你制作了一份总表你想要拆分成各个分公司，并且你需要对分公司的多个同事发送邮件。如果有20几个分公司，你要拆分+写邮件+选择接收者=20多次。

场景2：收集不同分公司的发过来的邮件进行整合汇总，同样的，如果你有20几个分公司发过来，你需要做20几次汇总。

power BI是能解决其中的汇总与拆分，但是很多特定的场景，还是需要由VBA定制解决。

所以我们经过大家反映，重新写了VBA代码，让大家更加智能化去运用这些场景。并且我们也对代码结构进行了通俗易懂地讲解。

这些都会更新在VBA代码长期分享文件夹里面。就让我们先来看下视频吧，一篇干货哦

干货篇幅较长，先给大家看结果

具体如何完成呢？正式走进文章一起练习啦

— 1 — VBA是什么电脑和人脑有很大的差别，有些事情人脑处理的很快，但是电脑处理的就慢，比如对图像的识别，人一眼就能看出来一张照片上有什么内容，可电脑对图像的识别也只是最近几年才刚刚能实现的新技术，还经常会犯错；但是有些工作电脑就比人脑厉害很多，比如大量的计算，比如重复做千百万次同样的操作。所以，当我们有些工作需要机械化的重复许多次的时候，把它教给电脑来处理就事倍功半，VBA就是这样一个能让电脑重复工作的神器！VBA是微软基于VB语言开发的一种寄生于其他应用程序里的语言，最常用的就是在OFFICE套件里比如Excel、World、PowerPoint都集成了VBA的开发环境，还有些其他软件也可以使用VBA，例如AutoCAD等。当然，VBA被使用最多的还是在Excel里，它可帮助我们处理各种需要大量重复的机械化操作。 — 2 — VBA和Python对比的优点另外提一下，近几年也有不少人用比较热门的Python语言来处理Excel表，不可否认，Python是一门强大的语言，处理表格也能又快又好。不过VBA在处理Excel表格上比起Python还是有很多很多的优势的，这里简单的说几条： 1 、例如，VBA不需要再安装软件部署开发环境，只要安装了Office的Excel软件就能直接使用，而想用Python还需要进行复杂的安装设置； 2 、VBA与Excel结合的非常好，可以直接调用绝大多数的Excel功能，比如复制、粘贴、筛选、填充公式等； 3、VBA可以直观的看到每段代码的运行效果，可以一步一步的看你的原始表格是怎么被转换运算的，编写调试非常直观； 4 、VBA还有个录制宏的逆天功能，可以录下来你的操作步骤，经过简单的修改就能使用。 — 3 — 案例介绍这次，我就带来了两段VBA代码的解析，如何把一张表根据某列的内容拆分成多个文件，并且可以把这些文件分别发送E-Mail给不同的人。这段代码适合什么做什么用呢？比如有些销售数据需要分别发送给不同的分部，比如工资表需要分别发送给不同的部门或员工等等情形。手工操作需要进行筛选、复制、新建一张表、另存、编写邮件填写内容和标题、添加附件、发送邮件。好了，终于完成了一个文件的发送，然后以上步骤再重复操作几十次，烦死了！这种机械化的重复劳动交给VBA来啊，几十秒就能全部完成了！本次案例是对一个销售的明细表按照F列的城市名进行拆分，然后把每个文件分别发送给不同的城市经理。

— 4 — 拆分文件案例解析用VBA编程其实还挺容易的，其实编程的框架已经出来了，就是上面我们那些手工操作的步骤，我们用计算机的代码一步一步实现这些步骤，并让电脑自己重复干几十次就好了。那么第一个步骤是什么呢？首先，我们需要给经常用的工作簿、工作表、单元格起个昵称，这样就不用每次都写全名了：

1. '设定本工作表为Wb1,设定要拆分的表为Sht,设定要拆分的列的表头单元格为Fie

2. Set Wb1 = ThisWorkbook

3. Set St1 = Wb1.Sheets("销售明细表")

4. Set Fie = St1.Range("F1")

然后，我们要搞清楚有哪些城市需要拆分是吧，所以先获取一个有哪些城市的名单。获取名单这事在VBA里最适合的就是用字典功能了。我们可以对要拆分的F列从F2开始一直到表格最后一行，把每个单元格的值都拿出来，如果是个新内容就加入到字典里，如果重复了就不管了

5. '建立一个拆分关键字的字典

6. Set Dic = CreateObject("Scripting.Dictionary")

7. '对表头下的所有单元格进行循环

8. For Each Rng In St1.Range(Fie.Offset(1, 0), Fie.End(xlDown))

9. '判断当前表格的值是否在字典内,如果不在,就添加到字典内

10. If Not Dic.exists(Rng.Value) Then

11. Dic.Add Rng.Value, ""

12. End If

13.Next

14.

VBA可以在零点零几秒内对几千个数据进行处理，然后我们就可以获取到一个城市列表啦，这列表里有9个值，分别是北京、大连、上海……运行过程中我们可以监视一下字典，看看结果：

好了，有了这份清单，我们就可以让VBA开始分别干活啦，就以这个清单为准运行9次，每次生成一个城市的文件，这时候我们就可以用到For循环功能了，对字典里的每个项目都运行一次生成表格的代码，每次的城市名字就用Itm这个变量名称呼它：

15.'针对字典内的每个值进行一次操作

16.For Each Itm In Dic.Keys

17. ......

18.Next

19.

那中间这个生成不同城市文件的代码又怎么写呢？真的非常简单，把我们日常的手工操作转换成代码就好啦，筛选、新建个表、复制过去、另存就搞定啦！下面代码的附注里都写上每句的功能了，就不再啰嗦介绍了：

20.'对拆分依据的列进行筛选

21.Fie.AutoFilter Field:=Fie.Column, Criteria1:=Itm

22.

23.'新创立一个工作薄并设定为Wb2，其中第一个表设定为St2

24.Set Wb2 = Workbooks.Add

25.Set St2 = Wb2.Sheets(1)

26.

27.'把当前表格区域所有没隐藏的单元格区域设定为Rng

28.Set Rng = Fie.CurrentRegion.SpecialCells(xlCellTypeVisible)

29.

30.'把Rng区域复制并选择性粘贴列宽到新表(保持新旧表列宽是一样的)

31.Rng.Copy

32.St2.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

33.'把Rng区域复制粘贴到新表

34.Rng.Copy St2.Range("A1")

35.

36.'把新工作簿另存一下

37.Wb2.SaveAs Filename:=ThisWorkbook.Path & "\拆分\" & Itm & ".xls" _

38. , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _

39. ReadOnlyRecommended:=False, CreateBackup:=False

40.'关闭新工作簿

41.Wb2.Close

42.'取消原表的筛选

43.Fie.AutoFilter

好啦，到这里，我们第一步就搞定了，已经获取这9张表啦：

最后，只要对代码进行些简单的修改，例如可以用代码把屏幕更新关闭，这样运行的时候屏幕就不用更新显示每步的运行结果，运算的速度就更快了。然后我们这段拆分文件的代码就大功告成！ — 5 — 发送邮件案例解析接下来，就到了分别发送邮件的环节了。到邮件这一步呢，操作涉及到的知识可能就多点了，不仅仅是要在Excel里操作单元格，还需要在硬盘里操作文件，然后还要发送E-mail。但其实只要把流程理顺，知道每一步要干什么，然后一个知识点一个知识点的理顺，就能完成啦！ 1、首先，我们设定一下邮箱联系人的工作表以及用来存储发送结果的工作表，然后找到发送结果表还没被使用过的新列，用来存储本次发送的结果

44.Set St1 = ThisWorkbook.Sheets("城市经理邮箱")

45.Set St2 = ThisWorkbook.Sheets("发送结果")

46.

47.'获取发送结果表没使用过的列

48.If St2.Range("A1").Value = "" Then

49. Col1 = 1

50.Else

51. Col1 = St2.Range("XFD1").End(xlToLeft).Column + 1

52.End If

然后再对这个列进行简单的修饰，并填写列标题

53.'填写发送结果列的表头，设置列宽和居中

54.St2.Columns(Col1).ColumnWidth = 25

55.St2.Cells(1, Col1).HorizontalAlignment = xlCenter

56.St2.Cells(1, Col1).Value = Date & Chr(10) & Time & Chr(10) & " 发送结果"

再接着，我们需要一个变量，来记录运行到第几个文件了，这样我们就知道下次该把发送结果写到第几行了。

57.n = 0

2、我们的初步准备工作刚才已经做完了，第二步呢，就是指定一个文件夹，然后找出其中所有的Excel文件。这一步听上去稍微有点复杂，不过其实是有套路可以用的，比如我们可以利用Windows系统自带的文件ActiveX控件来实现这个功能：

58.'套路：获取一个文件夹下的所有文件对象

59.Dim FS, F, FF, Fil

60.Set FS = CreateObject("Scripting.FileSystemObject")

61.Set F = FS.GetFolder(文件夹路径)

62.Set FF = F.Files

63.For Each Fil In FF

64. ......

65.Next

在上面这段代码里，FS就是控件，F就是获取到了一个文件夹对象，FF就是文件夹里的所有文件，然后我们再用For循环对FF里的每一个文件进行操作，这样我们就能获取到每个文件啦。

3、获取到文件之后再做什么呢，当时是找一下这个文件对应的收件人和邮箱啦，那怎么找呢？还记得文章最上面说的“VBA与Excel结合的非常好”这句特性吗，在这里我们可以很简单的利用Excel里的Match函数来搞定：

66.在通讯表的A列里用Excel的Match公式查找文件名所在行号

67.Row1 = Application.Match(FN, St1.Range("A:A"), 0)

进行查找之后，就该对结果进行一些分析，看看查找的结果是否满足发送邮件的要求，比如有可能找不到收件人，也有可能收件人的邮箱没填写或者格式不对，所以要进行一些判断

68.'用来记录操作到第几个文件了

69.n = n + 1

70.'获取文件的主文件名(不包含.xlsx等拓展名的文件名)

71.FN = FS.GetBaseName(Fil)

72.'在通讯表的A列里用Excel的Match公式查找文件名所在行号

73.Row1 = Application.Match(FN, St1.Range("A:A"), 0)

74.'判断下如果Row1是个错误值，就是没找到联系人

75.If IsError(Row1) Then

76. St2.Cells(n + 1, Col1).Value = "找不到“" & FN & "”的联系人"

77.'判断一下找到的联系人的邮箱是否是*@*.*格式

78.ElseIf Not St1.Cells(Row1, 3).Value Like "?*@?*.?*" Then

79. St2.Cells(n + 1, Col1).Value = "“" & FN & "”邮箱地址不正确"

80.'如果找到联系人，又获取到了邮件地址，就开始发送邮件

81.Else

4、现在，已经做完所有的准备工作啦，要开始发邮件啦，激动吗？不过，发送邮件之前呢，还需要获取到一些邮箱的设置信息，文末附录里会以QQ邮箱为例讲解怎么开通用第三方工具发送邮件的方法。其他邮箱可以在网上搜一下该如何设置，企业邮箱问IT小哥哥要一下参数就好啦！发送邮件需要用到一个CDO.Message的控件，先声明一个控件变量：

82.Set Cm = CreateObject("CDO.Message") '创建邮件对象

然后，这个控件主要分为几部分： (1) 设置邮件的发件人邮箱、收件人邮箱、主题、正文、附件等内容(注，在我这个案例里，我用了一个窗口来显示和记录邮箱的一些设置信息，这样可以比较方便的更换其他邮箱发送，代码里的“UserForm1.TextBox*”就是这些邮箱信息)：

83.'设置发信人的邮箱、收件人邮箱、邮件主题、邮件正文

84.Cm.From = UserForm1.TextBox1

85.Cm.To = St1.Cells(Row1, 3).Value

86.Cm.Subject = FN & "销售表"

87.Cm.TextBody = "亲爱的领导和同事：" _

88.& Chr(10) & " 附件为 " & FN & " 昨日的销售情况表，请您查收。" & Chr(10) & "谢谢！"

89.'邮件添加附件

90.Cm.AddAttachment Pth & Fil.Name

(2) 设置发件服务器信息

91.'对发件服务器进行配置

92.stUl = "http://schemas.microsoft.com/cdo/configuration/"

93.With Cm.Configuration.Fields

94. .Item(stUl & "smtpusessl") = 1

95. .Item(stUl & "sendusing") = 2

96. .Item(stUl & "smtpserver") = UserForm1.TextBox3 'SMTP邮件服务器地址

97. .Item(stUl & "smtpserverport") = UserForm1.TextBox4 'SMTP邮件服务器端口

98. .Item(stUl & "smtpauthenticate") = 1

99. .Item(stUl & "sendusername") = UserForm1.TextBox1 '发件人邮箱

100. .Item(stUl & "sendpassword") = UserForm1.TextBox2 '发件人密码/授权码

101. .Update

102.End With

(3) 发送邮件这部就相当简单啦：

103.'已完成设置，开始发送邮件

104.Cm.Send

(4) 发送之后，可以获取到是否成功发送的反馈结果，写入结果表：

105.'发送后生成反馈信息

106.If Err.Number = 0 Then

107. St2.Cells(n + 1, Col1).Value = "“" & FN & "”发送成功"

108.Else

109. St2.Cells(n + 1, Col1).Value = "“" & FN & "”发送失败"

110. Err.Clear

111.End If

再对代码进行些简单的修饰就可以啦！比如在代码的最后，我们可以加上这么一句来通知我们发送完毕啦：

112.msgbox("发送完毕")

下面就是本地案例的执行情况：

我的邮箱里也收到了一堆测试和演示时收到的邮件呢：

另外，成都的那个邮箱是我随便敲的，所以不一会儿就收到了退信，但是这个就不是VBA代码所关注的范畴啦，因为它当时真的发送成功了。

— 6 — 尾声好了，我们的案例讲解到此就结束啦，讲解的内容稍微有些长，不过当你把内容全都设置好，下次工作起来就很省心啦，运行一下“拆分”，再运行一下“发送”，等个几十秒，工作就完成啦！附：如何开通QQ邮箱的第三方发件功能现在的免费邮箱为了安全起见，大部分都默认关闭了第三方发送功能，所以需要手工开通。进入到QQ邮箱的“设置”功能，打开“账户”的设置选项，找到下面的“POP3/IMAP……服务”这一项，把对应的“POP3/SMTP服务”开启。

然后跟着提示，可能需要编写个短信发给腾讯，然后就能开通第三方发件功能啦。成功开通服务之后，QQ邮箱会显示一个授权码，要把这个授权码保存一下，在发信的时候需要需要用到。这个授权码是做什么呢的，其实它就是一个只能用来发邮件的密码，不能登录邮箱，也不能看到邮件内容。在早些年，用第三方软件收发信件要把邮箱密码保存到OutLook或者FoxMial软件里的，像我们的VBA代码也需要用明文存储这个密码，非常危险。所以腾讯有了这么个功能，保护你登录邮箱的密码，只能发信，这样就算这个密码被泄露了也没什么损失，非常安全。

当然，这个授权码要是泄露也不太好呢，因为别人就可以用你的邮箱给其他人发垃圾或者诈骗邮件，所以还是尽量别告诉别人啦，所以我的案例里也把这个授权码删掉了，大家想使用请用自己的邮箱测试哦。开通服务之后，还需要获取到发件服务器的地址和端口号，这个邮箱一般都有介绍，比如QQ邮箱就是点这里：

点开文章里就会介绍相关的内容，比如这里，我们就能获取到发件服务器地址和端口号，分别是smtp.qq.com和465，有了这两个信息，我们就可以用VBA发送邮件啦！

求资源，迫不及待想练习了.. 关注微信公众号：POINT小数点数据后台输入关键字： VBA长期分享你就会获得练习所需表格《拆分邮寄案例.xlsm》，还有一些比较通用型的VBA代码工作簿，比如拆分表格、分发邮件、合并各分公司数据等，注释也帮你写好了。

小伙伴们，转发这个利器给你的小伙伴们吧，因为我们会不断更新脚本哒~ 大家要是遇到一些比较典型的Excel问题需要VBA解决，可以留言，我们老师会定期筛选出典型案例，分享脚本给大家(这是免费的哦)

大家在后台留言不知道怎么启用宏，点点给大家录了视频了哦~

同时很欢迎大家报名学习VBA课程可以让你在实际处理Excel中大大提升工作效率！POINT.小数点Excel-VBA( 第十期)正式预售

点击图片加入看完觉得VBA太实用了！call王老师~

【本文地址】

vb表格控件

vb表格控件

今日新闻

推荐新闻