使用VBA小程序提高资产清查效率
搞资产清查就像是在玩“找茬”游戏，只不过你的“茬”是资产台账和实物记录之间的差异。去年你用LayUI+PHP+MS SQL Server 2014写了个程序，结果刚写完，LayUI就宣布“退休”了，程序也成了“前朝遗老”。今年你又得重新上阵，时间紧迫，只好祭出Excel VBA这个“老伙计”。
VBA就像是你手里的瑞士军刀，什么都能干，尤其是面对1500条数据时，它比人工核对快多了。想象一下，如果让你手动核对1500条数据，估计你会怀疑人生。而VBA呢？不到1分钟就搞定，简直就是“效率之神”。
不过，VBA的威力也取决于你的数据准确性和格式统一性。如果数据乱七八糟，VBA也只能帮你“望洋兴叹”。所以，在启动VBA之前，先确保你的数据是“干净”的，不然再好的工具也是白搭。
说到这里，你可能会问：为什么不用更高级的工具呢？比如Python或者R？嗯，这些工具确实更强大，但它们的入门门槛也更高。而VBA呢？几乎每个用Excel的人都懂一点，上手快，修改方便，特别适合那些“临时抱佛脚”的任务。
最后，别忘了，VBA虽然强大，但它也不是万能的。如果你的任务越来越复杂，或者需要长期使用，可能还是得考虑更系统的解决方案。但至少在目前，VBA是你快速搞定资产清查的不二之选。
资产清查是一件相当烦人的工作，去年使用LayUI+PHP+MS SQL Server 2014写了一个资产清查的程序，可惜写完了，LayUI已经停止更新了，就没有再完善下去，数据也没有更新，等于就废了。
今年又要进行资产清查，启用LayUI的程序，快一年没有弄了已经有些陌生了，也来不及整改了，就使用Excel的VBA来进行匹配。
资产清查，就是资产台账与实物记录进行匹配的，这个是很烦人的工作，因为资产台账和实物台账的数据都不一定准确，要核对好不是一件轻松的事情。
要手工去核对几乎不可能，比如1500条台账数据，实物也有1500条，核对上做上标记，看似简单，如果一个人做那么特别累，时间长也来不及，多人去做，数据怎样统一和共享是问题，所以，只能由程序来完成。
实际上工作中，这样的任务需要很短的时间去完成，没有必要开发一个系统来完成，因为界面部分就会耗去大量的时间，而直接使用Excel VBA就是一个不错的选择。
根据实际需要可以随时修改、优化程序，很大程度上提高了工作效率。
核对过程：
1、整理完整的资产台账和实物台账，要求数据必须准确、格式统一；
2、使用VBA小程序去匹配，可以按指定的条件去匹配，匹配上了就给实物发放一个资产编码；
3、最严格的匹配条件过后，可能有一些是匹配不上的，需要放松条件去匹配，匹配完成后针对匹配记录发放调配单。比如：因为某某原因，某一台设备由什么变为什么，由某一地点调配至另一地点等。
4、根据调配单更新资产台账和实物台账，匹配完成。
下面是代码部分：
主要涉及VBA的结构体传参、函数和过程调用、快速查找等功能。
⑴参数传递的结构体
'获取返回的信息结构体
Type StructGetInfoSDW As String '单位名称SGGXH As String '规格型号SWZ As String '位置SSYR As String '使用人SRow As String '匹配的行号
End Type'参数传递的结构体
Type StructParaSDW As String '单位名称SPP As String '品牌SGGXH() As String '规格型号SSheetName As String 'sheet名称SSrcRow As String '源数据行SZCBM As String '资产编码
End Type⑵定义设置和获取单元格值的方法
Public Sub SetCellValue(SCellName As String, SValue As String)Range(SCellName).SelectSelection.FormulaR1C1 = SValue
End SubPublic Function GetCellValue(SCellName As String)Range(SCellName).SelectGetCellValue = Selection.FormulaR1C1
End Function⑶根据匹配条件进行匹配的函数
Public Function FindAtMultiCol(MyStructPara As StructPara) As StructGetInfoDim SDW As String, SPP As String, SZCBM As String, SSheetName As StringDim SGGXH() As StringDim ws As WorksheetDim LastRow As LongDim iFor As IntegerDim FoundCell_DW As Range, FoundCell_PP As Range, FoundCell_GGXH As Range, FoundCell_ZCBM As Range, FoundCell_SignRow As Range, FoundCell_WZ As Range, FoundCell_SYR As RangeDim StrDW As String, StrPP As String, StrGGXH As String, StrZCBM As StringDim DawnGetInfo As StructGetInfo '返回信息的结构体SDW = UCase(MyStructPara.SDW)SPP = UCase(MyStructPara.SPP)SGGXH = MyStructPara.SGGXHSSheetName = UCase(MyStructPara.SSheetName)SSrcRow = UCase(MyStructPara.SSrcRow)SZCBM = UCase(MyStructPara.SZCBM)Set ws = Worksheets(SSheetName)LastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row'设置范围Set FoundCell_DW = ws.Range("C2:C" & Trim(Str(LastRow))) '单位名称Set FoundCell_PP = ws.Range("D2:D" & Trim(Str(LastRow))) '品牌Set FoundCell_GGXH = ws.Range("E2:E" & Trim(Str(LastRow))) '规格型号Set FoundCell_ZCBM = ws.Range("B2:B" & Trim(Str(LastRow))) '资产编码Set FoundCell_SignRow = ws.Range("A2:A" & Trim(Str(LastRow))) '标识行Set FoundCell_WZ = ws.Range("F2:F" & Trim(Str(LastRow))) '位置Set FoundCell_SYR = ws.Range("G2:G" & Trim(Str(LastRow))) '使用人DawnGetInfo.SDW = ""DawnGetInfo.SGGXH = ""DawnGetInfo.SRow = ""DawnGetInfo.SSYR = ""DawnGetInfo.SWZ = ""FindAtMultiCol = DawnGetInfoFor iFor = 1 To LastRow - 1StrDW = UCase(Trim(FoundCell_DW(iFor).Value))StrPP = UCase(Trim(FoundCell_PP(iFor).Value))StrGGXH = UCase(Trim(FoundCell_GGXH(iFor).Value))StrZCBM = UCase(Trim(FoundCell_ZCBM(iFor).Value))'If StrDW = SDW And StrPP = SPP And InStr(StrGGXH, SGGXH(0)) > 0 And InStr(StrGGXH, SGGXH(1)) > 0 And StrSign = "" ThenIf StrPP = SPP And InStr(StrGGXH, SGGXH(0)) > 0 And InStr(StrGGXH, SGGXH(1)) > 0 And StrZCBM = "" ThenFoundCell_ZCBM(iFor).Value = SZCBMFoundCell_SignRow(iFor).Value = SSrcRowDawnGetInfo.SDW = StrDWDawnGetInfo.SGGXH = StrGGXHDawnGetInfo.SRow = Str(FoundCell_ZCBM(iFor).Row)DawnGetInfo.SSYR = FoundCell_SYR(iFor).ValueDawnGetInfo.SWZ = FoundCell_WZ(iFor).ValueFindAtMultiCol = DawnGetInfoExit ForEnd IfNext
End Function⑷实际调用
Sub 资产核对()'Dawn 2023年4月19日Dim DawnPara As StructPara '参数传递的结构体Dim iFor As IntegerDim iFindCount As Integer '匹配的总数Dim DestRow As String '在目标表中匹配到的行号Dim allEquipment As Integer '计算机资产表的记录数Dim SrcTable As String '计算机资产表的名称Dim Src_DWMC As String '源表的单位名称Dim Src_PP As String '源表的品牌Dim Src_GGXH() As String '源表的规格型号Dim Src_ZCBM As String '源表的资产编码Dim DawnGetInfo As StructGetInfo '返回信息的结构体allEquipment = 12 '实际需要核对的记录数SrcTable = "资产表"For iFor = 1 To allEquipment'提取源表的单位名称、品牌、规格型号Sheets(SrcTable).ActivateDawnPara.SDW = Trim(UCase(GetCellValue("B" + Trim(Str(iFor))))) '单位名称DawnPara.SPP = Trim(UCase(GetCellValue("C" + Trim(Str(iFor))))) '品牌DawnPara.SSheetName = "计算机实物台账"DawnPara.SZCBM = Trim(UCase(GetCellValue("A" + Trim(Str(iFor))))) '资产编码DawnPara.SSrcRow = Str(iFor)DawnPara.SGGXH = Split(Trim(UCase(GetCellValue("D" + Trim(Str(iFor))))), " ") '规格型号If UBound(DawnPara.SGGXH) > 0 And DawnPara.SGGXH(0) <> "" ThenDawnGetInfo = FindAtMultiCol(DawnPara)If DawnGetInfo.SRow <> "" ThenCall SetCellValue("E" & Trim(Str(iFor)), DawnGetInfo.SRow)Call SetCellValue("F" & Trim(Str(iFor)), DawnGetInfo.SDW)Call SetCellValue("G" & Trim(Str(iFor)), DawnGetInfo.SGGXH)Call SetCellValue("H" & Trim(Str(iFor)), DawnGetInfo.SWZ)Call SetCellValue("I" & Trim(Str(iFor)), DawnGetInfo.SSYR)iFindCount = iFindCount + 1End IfEnd IfNextMsgBox "核对完毕！匹配数：" + Str(iFindCount)
End Sub使用VBA程序核对起来很快，1500条数据不到1分钟就核对完成，在数据准确的情况下匹配率令人满意，关键是速度快，省去了不少的时间。
