使用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分钟就核对完成，在数据准确的情况下匹配率令人满意，关键是速度快，省去了不少的时间。