Excel VBA 按项目把总表拆分表明细表真实案例

2024-06-08 31 0

本文首发于2023年5月30日于我的同名公众号,其他文章请搜索关注!

☆本期总结☆

VBA数组、字典

批量创建Excel文档

统一设置单元格格式

删除和添加图像

打印预览设置

大家好,我用冷水泡茶。昨天在EXCELHOME论坛上看到一位网友求助的帖子:

以上是要求、总列表和子列表。

我查了一下,发现并不难,只是设置分表格式花了一些时间。我也为其他人做过类似的事情。这次我不打算采取行动,所以我发了一条回复:

回到主题,我们来谈谈我们的主列表拆分的情况。

有集团公司,他们的人力资源是在集团内部管理的,所有员工的社保都是在大表里处理的。每个月,需要对每个法人单位的明细表进行细分,按照项目进行汇总,然后确定统一的格式,并可以直接打印,供管理层审批和签字。

它看起来像这样

需要按照拥有的公司进行细分,按照拥有的项目进行汇总。结果如下:

我们先看一下效果:

下面简单理清一下思路,这个思路和我之前提到的帖子的回复类似:

1、按公司拆分总表数据,提取多个表头字段,按项目汇总,按社保、公积金、年金划分。

2、每个公司三份文件(公司叫社保、储蓄基金、年金)

3在每个文件中,按月份创建一个表

4统一表格格式

5添加公司标志

接下来我们看一下制作流程和一些代码:

1输入usersfrom,使用月份的合并框控件并在其上键入一个选项。

2主程序分割代码,mySplit

(1)使用字典提取公司和项目列表:

Forg2ToiRow-41IfarrSE(g,3)''AndarrSE(g,4)''ThendGsKeyarrSE(g,3)dXmKeyarrSE(g,3)'▲'arrSE(g,4)DicGs(dGsKey)1'获取公司列表DicXm(dXmKey)1'获取项目列表(公司▲项目)EndIfNext

(2)提取各公司的项目数量:

'每个公司包含的项目数量(获取公司列表时也可以做,但公司和项目必须按顺序排列,不能穿插其他公司和项目)Fori0ToUBound(arrGs)Forj0ToUBound(arrXm)IfInStr(arrXm(j),arrGs(i)'▲')>0ThenarrXmS(i)arrXmS(i)1EndIfNextNext

(三)按项目汇总:

'基于projectReDimPreservearrSum(1ToUBound(arrXm)1,1ToUBound(arrSE,2))Fori0ToUBound(arrXm)arrSum(i1,4)arrXm(i)arrSum(i1,3)Left(arrXm(i),InStr(arrXm()的摘要i),'▲')-1)Forj2ToUBound(arrSE,1)IfarrSE(j,3)'▲'arrSE(j,4)arrXm(i)ThenFors5ToUBound(arrSE,2)-1IfarrSum(i1,s)''ThenarrSum(i1,s)arrSE(j,s)ElsearrSum(i1,s)arrSum(i1,s)arrSE(j,s)EndIfNextEndIfNextNext

(4)按公司创建档案:

ForiLBound(arrGs)ToUBound(arrGs)'按公司创建文件fleNamearrGs(i)Left(iMonth,4)'年'SplitType'付款汇总表xlsx'PathfilePathfleNamesResultDir(sPath)IfLen(sResult)0Then'新建工作簿,分别为各公司保存文件SetexcelAppCreateObject('ExcelApplication')SetexcelWBexcelAppWorkbooksAdd'新文件名excelWBSaveAsfilePathfleNameexcelAppQuitEndIfNext

(5)然后,浏览公司列表并一一提取数据。

(A)首先判断文件是否打开,如果打开则启用,如果未打开则打开:

对于每个WBInWorkbooksIfdstWBNamefleNameThenwbIsOpenTruedstWBActivateExitForEndIfNextIfNotwbIsOpenThenWorkbooksOpenFilename:filePathfleNameEndIf

(B)公司档案中的操作表。如果本月的工作表不存在,请创建一个。

IfNotwbSheetExists(shtName)ThenWithActiveWorkbookSetwksShtWorksheetsAdd(after:Sheets(SheetsCount))EndWithwksShtNameshtNameElseSheets(shtName)CellsClearForEachsPicInActiveSheetShapessPicDeleteNextEndIf

(C)根据不同的分割类型写入头信息:

IfSplitType'五险'ThenReDimarrTem(1TolastRow,1To12)TitlePosArray(1,4,7,9,12,14,17,19,22)ActiveSheetCells(5,3)'退休险'Sheets(shtName)Range(Cells(5,3),Cells(5,4))SelectWithSelectionMergeAcross:FalseHorizo??ntalAlignmentxlHAlignCenterEndWithActiveSheetCells(5,5)'工作表'健康/生育保险'(shtName)Range(Cells(5,5),Cells(5,6))SelectWithSelectionMergeAcross:FalseHorizo??ntalAlignmentxlHAlignCenterEndWithActiveSheetCells(5,7)'Sheets失业保险(shtName)Range(Cells(5,7),Cells(5,8))SelectWithSelectionMergeAcross:FalseHorizo??ntalAlignmentxlHAlignCenterEndWithActiveSheetCells(5,9)'工伤保险'ActiveSheetCells(5,10)'合计'Sheets(shtName)Range(Cells(5,10),Cells(5,11))SelectWithSelectionMergeacross:falsehorizo??ntalAntignmentxlhalignCenterendWithActiveSheet然后

(D)提取数据,将其存储在arrTem()数组中,然后立即将其写入工作表:

Forg1ToUBound(arrSum,1)IfarrSum(g,3)arrGs(i)ThenarrTem(k,1)karrTem(k,2)Right(arrSum(g,4),Len(arrSum(g,4))-InStr(arrSum)(g,4),'▲'))Forh2ToUBound(TitlePos)arrTem(k,h1)arrSum(g,TitlePos(h))NextIfSplitType'五风险'ThenarrTem(k,10)arrTem(k,3)arrTem(k,5)arrTem(k,7)arrTem(k,9)arrTem(k,11)arrTem(k,4)arrTem(k,6)arrTem(k,8)arrTem(k,12)arrTem(k,10))arrTem(k,11)ElseIfSplitType'住房公积金'ThenarrTem(k,5)arrTem(k,3)arrTem(k,6)arrTem(k,4)arrTem(k,7)arrTem(k,5)arrTem(k,6)ElseIfSplitType'年金'ThenarrTem(k,5)arrTem(k,3)arrTem(k,6)arrTem(k,4)arrTem(k,7)arrTem(k,5)arrTem(k,6)EndIfForp3ToUBound(arrTem,2)arrTem(lastRow,p)arrTem(lastRow,p)arrTem(k,p)Nextkk1EndIfNextiColUBound(arrTem,2)'将结果填充到表格Sheets(shtName)Range('A7')Resize(UBound(arrTem,1)),iCol)arrTem

(E)填写一些必填信息,添加公司标志图片,并设置表格格式:

Sheets(shtName)Range('A2')arrGsqc(i)Sheets(shtName)Range(Cells(2,1),Cells(2,iCol))Select'BigTitleWithSelectionMergeAcross:FalseHorizo??ntalAlignmentxlHAlignCenterFont。Size18FontName'宋体'EndWithSheets(shtName)Range('A3')Left(iMonth,4)'年'Val(Right((iMonth),2))'月'SplitType'付款汇总表'表格(shtName)Range(Cells(3,1),Cells(3,iCol))Select'SubtitleWithSelectionMergeAcross:FalseFontSize14Horizo??ntalAlignmentxlHAlignCenterFontBoldTrueEndWithSheets(shtName)Cells(4,iCol)'单位:元''Sheets(shtName)格式设置Range(Cells(5,1),Cells(lastRow6,iCol))Select'表格行WithSelectionBordersLineStylexlContinouslyColorIndex1WeightxlThinEndWithWithSelection'BorderAroundxlContinously,xlMedium,1RowHeight24Horizo??ntalAlignmentxlCenterVerticalAlignmentxlCenter'WrapTextTrue'FontName'etc'EndWith'添加图片LOGOActiveSheetPicturesInsert(filePath'logopng')SelectWithSelectionShapeRangeLeft0Top0Height1。2*72/254Width493*72/254EndWithRange('A2')SelectWithActiveSheetPageSetupZoomFalse'PrintAreaActiveSheetRange(Sel(1,1),Sel(signRow,iCol-1))'//打印区域FitToPagesWide1'//页面宽度为一页FitToPagesTallFalse'//页面高度为一页PaperSizexlPaperA4'//纸张尺寸OrientationxlLandscape'//水平打印'CenterFooter'P页,共N页''PrintTitleRows'$4:$4'结尾为

(6)最后打开文件夹

'打开分割文件所在目录Shell'explorerexe'ThisWorkbookPath,vbMaximizedFocuS

到这里就基本完成了,其他的按钮就不说了。上面的代码示例只是其中的一部分。有兴趣的朋友可以参考第二篇文章。好啦,今天就讲到这里。欢迎点赞、评论和分享。谢谢大家,下次再见。

☆你可能会喜欢☆

本文是使用文章同步助手同步的。本文首发于2023年5月30日于我的同名公众号,其他文章请搜索关注!

本站文章均由用户上传或转载而来,该文章内容本站无法检测是否存在侵权,如果本文存在侵权,请联系邮箱:2287318951@qq.com告知,本站在7天内对其进行处理。

发布评论