批处理多表统一执行宏

guanxiaowei

假设我们有这么一个需求：我们需要一个文件夹下的所有表（还包括子文件夹中的）做一个统一的处理，比如把所有的表每行求和并添加最后一列。

可以在表中加入宏，如下。功能就是对表中每一行求和。

代码如下：

Sub summ()

Dim row, col
row = Sheets(1).UsedRange.Rows.Count
col = Sheets(1).UsedRange.Columns.Count
   
For i = 1 To row
   
   Dim sum As Integer
   sum = 0
   For j = 1 To col
        Dim s As Integer
        s = Sheets(1).Cells(i, j).Value
        sum = sum + s
   Next j
   Sheets(1).Cells(i, col + 1).Value = sum
Next i
   
End Sub
（图片1）
点击 开发工具->宏->出现这个界面，点击执行
（图片2）

这样就对单个表做完了处理。

需要让表中没有这个宏模块也运行这个宏，我先将这个宏模块导出保存 Macro1.bas。

在OpenExcelAddMacroRun代码中打开表格，导入这个宏，执行宏，然后保存，关闭。这个代码是VBS写的

代码如下：

表名Option Explicit

Dim macroFileName,excelFileName,macroName
excelFileName = "a.xlsm"
macroFileName = "macroFileName"
macroName="macroName"

Dim excelApp, objWbk, excelPath

Dim inputRight
inputRight=False

With WScript
        ' to get current cmd folder path
  excelPath = Replace(.ScriptFullName, .ScriptName, "")
  'args
  If WScript.Arguments.count=3 Then
        excelFileName=WScript.Arguments(0) '
        macroFileName=WScript.Arguments(1)
        macroName=WScript.Arguments(2)
        inputRight=True
        Else
        WScript.Echo "Args count error!  need count 3, excelFileName macroFileName macroName"
  End If
End With

If inputRight Then

WScript.Echo "Run ExcelName: '" & excelFileName & "'"

Set excelApp = CreateObject("Excel.Application")

excelApp.EnableEvents = False

Set objWbk = excelApp.Workbooks.Open(excelPath & excelFileName, True, False)

excelApp.Visible = False

dim oComponents,oModule,fullFunction
set oComponents = objWbk.VBProject.VBComponents

set oModule = oComponents.Import(macroFileName)

fullFunction = Trim(oModule.Name & "." & macroName)

excelApp.Run(fullFunction)
oComponents.Remove(oModule)

objWbk.Save()
objWbk.Saved = True
objWbk.Close False
Set objWbk = Nothing

excelApp.EnableEvents = True
excelApp.ActiveWorkbook.Close
Set excelApp = Nothing

End If


运行代码需要三个参数 表名相对路径 刚导出的bas路径 bas中宏名

现在用批处理 获取文件夹下所有的*.xls文件 ，对每个表执行OpenExcelAddMacroRun


代码如下：

@echo off & setlocal EnableDelayedExpansion

set alldir=%~dp0

for /f "delims=" %%i in ('"dir /s/b/on *.xls"') do (

        set file=%%~fi

        set sortfile=!file:%alldir%=!

        set code=OpenExcelAddMacroRun.vbs !sortfile! !alldir!Macro1.bas summ
       
        cscript !code!

)
pause


点击Run.bat就可以对文件夹下所有表做求和处理。

如果表需要其他修改，只需要修改Macro1.bas中代码。

wushaominkk

【公告】发帖代码插入以及添加链接教程（有福利）
https://www.52pojie.cn/thread-713042-1-1.html
(出处: 吾爱破解论坛)

BBK147258369

下载看看

deqian0313

我目前只会录制宏~~

a2523188267

浪费表情，发重帖，还要下载扣CB，浪费我的1CB

Simpleton

感谢分享

Bingo2018

兄弟能帮我优化一个VBA代码吗

weiyanli

感谢分享

kuangxiao

感谢分享

我爱破解115

那如果要对每一列跟制定列求和该怎么做呢