成都网站代运营,h5制作平台教程,网站开发价格 北京,seo排名工具给您好的建议下载官网功能描述#xff1a;
一个Excel文件有很多个 样式相同 的数据表#xff0c;
需要将多张数据表的内容合并到一张数据表里。
vba实现代码如下#xff1a;
Attribute VB_Name NewMacros
Option Explicit
Public Const Const_OutSheetName As String V…功能描述
一个Excel文件有很多个 样式相同 的数据表
需要将多张数据表的内容合并到一张数据表里。
vba实现代码如下
Attribute VB_Name NewMacros
Option Explicit
Public Const Const_OutSheetName As String VBA汇总
Public Const Const_PZSheetName As String 配置Sub 汇总()
Attribute 汇总.VB_Description 宏由 LiuZW 录制时间: 2023/08/19
Attribute 汇总.VB_ProcData.VB_Invoke_Func 14汇总 Macro宏由 LiuZW 录制时间: 2023/08/19
Dim i, j, k As Integer创建“配置”数据表并提示用户填写配置Dim isExistPZ As BooleanisExistPZ FalseFor i 1 To Worksheets.CountIf Worksheets(i).name Const_PZSheetName ThenisExistPZ TrueExit ForEnd IfNext定义表示要复制的区域的变量Dim mRow1, mColumn1, mRow2, mColumn2 As IntegerIf isExistPZ ThenmRow1 Application.Worksheets(Const_PZSheetName).Range(B2).ValuemRow2 Application.Worksheets(Const_PZSheetName).Range(B3).ValuemColumn1 Application.Worksheets(Const_PZSheetName).Range(B4).ValuemColumn2 Application.Worksheets(Const_PZSheetName).Range(B5).ValueIf mRow1 0 Or mRow2 0 Or mColumn1 0 Or mColumn2 0 Then提示用户填写MsgBox (请填写配置数据表后运行。)Exit SubEnd If配置的填写有效性判断If Not IsNumeric(mRow1) Or Not IsNumeric(mRow2) Or Not IsNumeric(mColumn1) Or Not IsNumeric(mColumn2) ThenMsgBox (配置数据表中键入的区域表述无效请键入数字格式的行列号。)Exit SubEnd IfElse创建“配置”数据表Sheets.AddActiveSheet.name Const_PZSheetName填写基础信息Application.Worksheets(Const_PZSheetName).Range(A1).Value 不需要汇总的数据表名称Application.Worksheets(Const_PZSheetName).Range(B1).Value Const_PZSheetNameApplication.Worksheets(Const_PZSheetName).Range(C1).Value Const_OutSheetNameApplication.Worksheets(Const_PZSheetName).Range(A2).Value 复制区域的起始行Application.Worksheets(Const_PZSheetName).Range(A3).Value 复制区域的终止行Application.Worksheets(Const_PZSheetName).Range(A4).Value 复制区域的起始列Application.Worksheets(Const_PZSheetName).Range(A5).Value 复制区域的终止列提示用户填写MsgBox (请填写配置数据表后运行。)Exit SubEnd If判断是否已有“VBA汇总”数据表For i 1 To Worksheets.CountIf Worksheets(i).name Const_OutSheetName ThenMsgBox (要生成的数据表“ Const_OutSheetName ”存在同名数据表请修改或删除同名数据表后重试。)Exit SubEnd IfNext创建“VBA汇总”数据表Sheets.AddActiveSheet.name Const_OutSheetNameColumns(A:A).SelectSelection.NumberFormatLocal 复制各个数据表的数据并粘贴到汇总表For i 1 To Worksheets.CountDim mSheetName As StringmSheetName Worksheets(i).name判断当前数据表是否为 无需汇总的数据表MsgBox (当前数据表的第一行一共有 CStr(Application.CountA(Sheets(Const_PZSheetName).Rows(1))) 个数据)定义当前数据表是否为 无需汇总的数据表 的标记True表示无需汇总False表示需要汇总Dim mKey As BooleanmKey FalseFor j 2 To Application.CountA(Sheets(Const_PZSheetName).Rows(1))If mSheetName Sheets(Const_PZSheetName).Cells(1, j) ThenMsgBox (当前数据表“ mSheetName ”是不需要汇总的数据表)mKey TrueExit ForEnd IfNext如果当前数据表不是 无需汇总的数据表就执行汇总If mKey False Then执行复制和粘贴Application.Worksheets(mSheetName).ActivateApplication.Worksheets(mSheetName).Range(Cells(mRow1, mColumn1), Cells(mRow2, mColumn2)).SelectSelection.Copy判断要粘贴的位置并粘贴Application.Worksheets(Const_OutSheetName).ActivateDim usableRowCount As IntegerusableRowCount Application.Application.Sheets(Const_OutSheetName).Range(b65536).End(xlUp).Row 2Application.Worksheets(Const_OutSheetName).Cells(usableRowCount, 2).SelectSelection.PasteSpecial Paste:xlPasteValues, Operation:xlPasteSpecialOperationNone, SkipBlanks:False, Transpose:False填充第一列For k 0 To mRow2 - mRow1Application.Worksheets(Const_OutSheetName).Cells(usableRowCount k, 1).Value mSheetNameNextEnd IfNext
End Sub 文件链接数据表合并.bas
下载后直接在excel 查看代码处导入文件即可。
