*使用VBA，优化处理Excel表格

上周末，XX给我抱怨：因为计算绩效奖金，把2个人的工资发错了，还被扣了500元。问的缘由得知，她每个月要处理十来个excel表格，每次都要手动修改里面的值，如果修改了一处，其他地方也要修改，然后还要多处地方核对。导致光这件事情就要消耗三四天，伤神费力。

我就问她，整个是不是都是机械性重复的工作，如果是的话，完全可以用电脑来代替。然后我就帮她找工具来优化她的工作，减少出错机会。

现状

目前他们公司总共有四五十人；
需要整理的excel有12份；
excel间有很多重复数据，同样的数据存在在多分表中；
excel之间相互引用数据很频繁，杂乱，牵一发而动全身。

两种方案

使用HRM管理系统，在网上找到三套有源码的软件：
- 仅仅在github上面找到一个中文的系统 hrms(github大量英文系统)。–需要自己找服务器部署
- 悟空HRM，PHP开源，文档也比较详细，中文。试用了一下在线版本，功能无法满足需求，需要二次开发，同步需要服务器部署。
- OrangeHRM，是阿里云市场里面，也需要购买服务器。
- 总结：现在目前找到的都是web版的系统，都需要在线部署。没有找到桌面版本，可以立即使用的那种。都不太适合目前的情况。
使用Excel自带的函数和宏，来实现简化实际工作的，最终实现此方案：
- 重新梳理Excel间的关系，提取出：原始数据、规则(函数计算后的数据)；
- 原始数据，抽取出来作为独立的Excel，类似于数据库的概念：
  - 稳定数据：不经常变动的数据，如：人员基本信息，固定工资等；
  - 月数据：每月统计都会发生变化的数据，如：考勤数据，绩效等；
- 规则，编辑成Excel模板文件(*.xltx)，里面一定不存在原始类的数据：
  - 引用：引用自原始数据，所有引用只能来源原始数据，不能出现引用引用的数据；
  - 计算公式：使用excel的函数，如：=sum()等；
- 使用VBA宏，根据原始数据和模板文件，生成不带公式的纯xlsx文件。目的，不依赖其他文件。

宏代码

实现功能（下载demo）：

批量读取模板文件，生成xlsx文件；官方文档另存的枚举类型
替换掉excel中的公式，只显示值。

全部宏代码

Sub ChangeFileFormat(xltxFolder, xlsxFolder)
<span class="k">Dim</span> <span class="n">strCurrentFileExt</span>   <span class="ow">As</span> <span class="kt">String</span>
<span class="k">Dim</span> <span class="n">strNewFileExt</span>       <span class="ow">As</span> <span class="kt">String</span>
<span class="k">Dim</span> <span class="n">objFSO</span>              <span class="ow">As</span> <span class="kt">Object</span>
<span class="k">Dim</span> <span class="n">objFolder</span>           <span class="ow">As</span> <span class="kt">Object</span>
<span class="k">Dim</span> <span class="n">objFile</span>             <span class="ow">As</span> <span class="kt">Object</span>
<span class="k">Dim</span> <span class="n">xlFile</span>              <span class="ow">As</span> <span class="n">Workbook</span>
<span class="k">Dim</span> <span class="n">strNewName</span>          <span class="ow">As</span> <span class="kt">String</span>
<span class="k">Dim</span> <span class="n">strXltxFolderPath</span>       <span class="ow">As</span> <span class="kt">String</span>
<span class="k">Dim</span> <span class="n">strXlsxFolderPath</span>       <span class="ow">As</span> <span class="kt">String</span>

<span class="k">Set</span> <span class="n">objFSO</span> <span class="o">=</span> <span class="n">CreateObject</span><span class="p">(</span><span class="s">&#34;Scripting.FileSystemObject&#34;</span><span class="p">)</span>

<span class="n">strCurrentFileExt</span> <span class="o">=</span> <span class="s">&#34;.xltx&#34;</span>
<span class="n">strNewFileExt</span> <span class="o">=</span> <span class="s">&#34;.xlsx&#34;</span>

<span class="n">strXltxFolderPath</span> <span class="o">=</span> <span class="n">ThisWorkbook</span><span class="p">.</span><span class="n">Path</span> <span class="o">&amp;</span> <span class="s">&#34;\&#34;</span> <span class="o">&amp;</span> <span class="n">xltxFolder</span> <span class="o">&amp;</span> <span class="s">&#34;\&#34;</span>
<span class="n">strXlsxFolderPath</span> <span class="o">=</span> <span class="n">ThisWorkbook</span><span class="p">.</span><span class="n">Path</span> <span class="o">&amp;</span> <span class="s">&#34;\&#34;</span> <span class="o">&amp;</span> <span class="n">xlsxFolder</span> <span class="o">&amp;</span> <span class="s">&#34;\&#34;</span>

<span class="k">If</span> <span class="k">Not</span> <span class="n">objFSO</span><span class="p">.</span><span class="n">FolderExists</span><span class="p">(</span><span class="n">strXltxFolderPath</span><span class="p">)</span> <span class="k">Then</span>   <span class="c">&#39;判断指定文件夹是否存在 

        MsgBox "【模板文件】文件夹不存在"
Exit Sub
End If
<span class="k">If</span> <span class="k">Not</span> <span class="n">objFSO</span><span class="p">.</span><span class="n">FolderExists</span><span class="p">(</span><span class="n">strXlsxFolderPath</span><span class="p">)</span> <span class="k">Then</span>   <span class="c">&#39;判断指定文件夹是否存在

        fs.CreateFolder strXlsxFolderPath
End If
<span class="k">Set</span> <span class="n">objFolder</span> <span class="o">=</span> <span class="n">objFSO</span><span class="p">.</span><span class="n">getfolder</span><span class="p">(</span><span class="n">strXltxFolderPath</span><span class="p">)</span>
<span class="k">For</span> <span class="k">Each</span> <span class="n">objFile</span> <span class="ow">In</span> <span class="n">objFolder</span><span class="p">.</span><span class="n">Files</span> <span class="c">&#39;循环所有的模板文件

        strNewName = objFile.Name
If Right(strNewName, Len(strCurrentFileExt)) = strCurrentFileExt Then
Application.AskToUpdateLinks = False     '关闭程序询问更新链接提示
            Application.DisplayAlerts = False
ThisWorkbook.UpdateLinks = xlUpdateLinksAlways  '更新链接

Set xlFile = Workbooks.Open(objFile.Path, , True) '读取模板文件
            For Each sh In xlFile.Sheets  '替换文件中的公式
               sh.UsedRange.Value = sh.UsedRange.Value
Next
        <span class="n">strNewName</span> <span class="o">=</span> <span class="n">Replace</span><span class="p">(</span><span class="n">strNewName</span><span class="p">,</span> <span class="n">strCurrentFileExt</span><span class="p">,</span> <span class="n">strNewFileExt</span><span class="p">)</span> <span class="c">&#39;替换文件名为新的文件名

            Select Case strNewFileExt
Case ".xlsx"
xlFile.SaveAs strXlsxFolderPath & strNewName, XlFileFormat.xlOpenXMLWorkbook '保存为不带宏的excel
            Case ".xlsm"
xlFile.SaveAs strXlsxFolderPath & strNewName, XlFileFormat.xlOpenXMLWorkbookMacroEnabled '保存为带宏的excel
            End Select
xlFile.Close
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End If
Next objFile
ClearMemory:
strCurrentFileExt = vbNullString
strNewFileExt = vbNullString
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
Set xlFile = Nothing
strNewName = vbNullString
strFolderPath = vbNullString
End Sub

总结

在这个过程中，考虑的时候，使用到了：模块，数据唯一性，避免交叉引用，这些开发中的经验。
其实我觉得，整个过程中，VBA的编写占据了我最多的时间。查资料，找文档。（百度就是个大坑！！！）
不熟悉Excel函数导致，当我写完一个宏的时候，发现VLOOKUP已经早就实现这个功能了。

文章目录

现状

两种方案

宏代码

总结