在企业管理中，特别是在物流、安装服务等行业中，对送货师傅和安装人员的费用统计是日常运营中不可或缺的一环。这些费用数据往往散落在各种Excel表格中，难以快速、准确地汇总和分析。为了提升工作效率，减少人工错误，我们设计了一个基于VBA（VisualBasicforApplications）的Excel宏，名为“主程序”，该宏能够自动从原始数据表中识别送货师傅、安装人员及其对应的费用，并将这些信息汇总到一个新的工作表“汇总表”中，同时计算出每位送货师傅的总运费和每位安装人员的总安装费。
此外，为了提供更全面的数据分析支持，我们还附加了一个名为“子程序”的子程序，它能够在“汇总表”中自动计算每位送货师傅和安装人员的总费用（运费加安装费），并在D列显示，同时在表格底部添加总计行，显示所有费用的总和。此功能不仅简化了数据汇总过程，还使得费用分析更加直观、便捷。
本VBA宏的设计充分考虑了数据的灵活性和可扩展性，能够自动适应不同格式的数据表，只需确保原数据表（本例中为“源表”）的列标题中包含“送货师傅”、“安装人员”和“运费”等关键字即可。通过此宏，企业可以大大提高费用统计的效率和准确性，为管理决策提供有力的数据支持。
代码如下：
Sub主程序()DimwsAsWorksheetDimsummaryWsAsWorksheetDimlastRowAsLong,lastColAsLongDimiAsLong,jAsLongDimdeliveryColsAsCollectionDiminstallColsAsCollectionDimdeliveryFeeColsAsCollection'设置原数据工作表Setws=("源表")lastRow=(,1).(xlUp).rowlastCol=(2,).(xlToLeft).Column'查找或创建Summary工作表OnErrorResumeNextSetsummaryWs=("汇总表")IfsummaryWsIsNothingThenSetsummaryWs=(After:=())="汇总表"IfOnErrorGoTo0'恢复正常错误处理'清空Summary表=NewCollectionSetinstallCols=NewCollectionSetdeliveryFeeCols=NewCollection'查找包含"送货师傅"、"安装人员"、"运费"的列Fori=1TolastColIfInStr((2,i).Value,"送货师傅")0((2,i).Value,"安装人员")0((2,i).Value,"运费")0=CreateObject("")'收集姓名并初始化费用统计Fori=3TolastRow'从第三行开始遍历数据行'收集送货师傅((i,col).Value)(i,col).Value""(i,col).Value,Array(0,0)IfNextcol'收集安装人员((i,col).Value)(i,col).Value""(i,col).Value,Array(0,0)IfNextcolNexti'统计费用Fori=3TolastRow'累加送货师傅的运费(i,col).Value""ThenDimfees()AsVariantfees=nameDict((i,col).Value)ForEachfeeColIndeliveryFeeColsfees(0)=fees(0)+(i,feeCol).ValueNextfeeColnameDict((i,col).Value)=feesIfNextcol'累加安装人员的安装费(i,col).Value""ThenDimpersonNameAsStringpersonName=(i,col).Valuefees=nameDict(personName)'假设安装费在安装人员列的右侧Ifcol+1=lastColThenfees(1)=fees(1)+(i,col+1).ValueIfnameDict(personName)=feesIfNextcolNexti'输出结果到Summary表(1,1).Value="姓名"(1,2).Value="总运费"(1,3).Value="总安装费"DimoutputRowAsLongoutputRow=2'从第二行开始输出(outputRow,1).Value=keyfees=nameDict(key)(outputRow,2).Value=Round(fees(0),1)(outputRow,3).Value=Round(fees(1),1)outputRow=outputRow+1NextkeyCall子程序SubSub子程序()DimwsAsWorksheetDimlastRowAsLongDimiAsLong'设置要操作的工作表Setws=("汇总表")'修改为你的工作表名'查找A列最后一行有数据的单元格lastRow=(,"A").(xlUp).row'在D列第一行写入标题(1,"D").Value="合计"'遍历A列和B列的数据，从第二行开始（假设第一行是标题）Fori=2TolastRow'对A列和B列的当前行进行求和，并将结果放在D列的当前行'(i,"D").Value=(i,"B").Value+(i,"C").(i,"D").Value=Round((i,"B").Value+(i,"C").Value,1)totalSum=totalSum+(i,"B").Value+(i,"C").(lastRow+1,"D").Value="总计"(lastRow+2,"D").Value=totalSum'设置A列到D列的格式：文字居中和添加边框("A1:D"lastRow+2).HorizontalAlignment=xlCenter'文本居中'添加边框==0.Weight==xlContinuousWithWithSub运费和安装费清单（部分）
代码实现结果
