最近一起创业的朋友又回去做老本行了，感谢她陪我一起创业的经历，寻思帮她把一些日常的工作变得自动化以节约时间，她做财务类工作，有时候会需要把一些报表整理合并，需要用到excel，本来想用python程序来完成，但语言都是想通的，既然用到excel，想想可以学习一下VBA，用excel的宏来定义，这样更方便，于是买了两本书查看了一下官方文档来学习VBA，并把此工作当做一个项目来完成。以下小记一下VBA的学习心得。
用到的工具：Excel，VBA
书：《Excel VBA 经典代码应用大全》、《Power Query 数据清洗实战》——Excel Home
先说一下看书的结论，感觉没啥用，感觉比较基础，虽然网上都说《Excel VBA 经典代码应用大全》这本书是进阶书籍，但是我感觉如果有编程经验只是想写一个实战项目来运用一下不如直接买一本入门的书籍翻翻语法就行，要么就直接去看官方文档--开发人员工具、技术文档和代码示例 | Microsoft Docs，书中一些代码感觉就是通过录制宏得到的，在我写程序想查看有关操作，很多描述没法给我更好的程序优化启示，简单来说就是本书比较厚知识内容较多较杂对部分操作并不深入，适合新手小白系统的学习VBA，另外power query是Excel2016之后版本的新操作，大概看了一下，在某些方面确实可以替代VBA了，主要用于数据的清洗，因为我看目录的时候我看有关于多个工作簿合并的操作，但是买书读后发现都有条件要求，就是需要表格比较统一化，这就让我较为失望，因为我查看了朋友有关需要合并的文件，发现格式各样，真是不太利于自动化合并。
下面将记录项目的总结。
将项目的需求简单记录如下：
1. 多个工作簿合并；
2. 不同格式合并；
3. 添加序号和备注，其中备注为导入的文件名称
合并格式模板图
本文对基础操作不说明，大家可以自行百度。
下面对难点分别进行说明，最后将附上完整代码，也许能帮上需要的人。
1. 创建工作簿，并以当前日期命名。
Sub CreateNewWorkbook()
Dim FileName As String
FileName = Year(Now()) & "-" & Month(Now()) & "-" & Day(Now()) & "_" & "信息汇总.xlsx"
Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & FileName
'Workbooks(FileName).Worksheets("Sheet1").Cells(1, 1) = "aaa"
End Sub
2. 批量修改表名
Sub EditSheetName()
Dim i As Integer
For i = 1 To Worksheets.Count
Worksheets(i).name = "信息汇总" & i
Next
End Sub
3. 添加标题，将标题用数组的格式存储，并用for循环批量输出，再转换为range并批量更改格式。
Sub AddTitle()
Dim xx As Range
Dim i, j As Integer
Dim ws1 As Worksheet
Dim title As Variant
Set ws1 = Worksheets(1)
title = Array("序号", "姓名", "身份证号", "银行卡号", "开户银行", "应发金额", "个税", "实发金额", "备注")
With ws1
For i = LBound(title) To UBound(title)
Cells(1, i + 1) = title(i)
Next i
End With
Set xx = Range("A1:I1")
'xx.Parent.Name = "汇总"
With xx.Font
.name = "黑体"
.Size = 16
.Bold = False
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With xx
.Rows.AutoFit
.Columns.AutoFit
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.ColumnWidth = 16 '行宽
End With
End Sub
4. 插入序号
Sub InsertSerialNum()
Dim row, intCounter As Integer
row = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).row
For intCounter = 1 To row - 1
ActiveSheet.Cells(intCounter + 1, 1).Value = intCounter
Next
End Sub
5. 插入备注，文件名.name属性自带文件名后缀.xlsx，使用字符串截取去掉后缀。
Set file = Workbooks.Open(file)
file_name = Left(file.name, Len(file.name) - 5)
If TempRowNum = 1 Then
ThisWorkbook.Sheets(1).Cells(row + 1, 9) = file_name
Else
For i = row + 1 To row + TempRowNum
ThisWorkbook.Sheets(1).Cells(i, 9) = file_name
Next
End If
下一篇将重点讨论，对不同的格式如何读取数据。
网友评论