使用VBS对Excel文件内容进行批量替换

1、通过读取外部txt文件的方式进行替换

Option Explicit

If Wscript.Arguments.Count = 0 Then
WScript.EchoChr(10) &_"[正确操作]" & Chr(10) & Chr(10) &_Chr(9) & "拖拽导出的Excel文件到本程序" & Chr(10) & Chr(10) &_"[错误操作]" & Chr(10) & Chr(10) &_Chr(9) & "双击本程序"WScript.QuitEnd If

DimxlsFilePath

xlsFilePath=WScript.Arguments(0)DimWshellSet Wshell=CreateObject("Wscript.Shell")If LCase(Right(WScript.FullName,11)) = "wscript.exe" ThenWshell.Run"CScript.exe //nologo" &_Chr(32) &_Chr(34) & WScript.ScriptFullName & Chr(34) &_Chr(32) &_Chr(34) & WScript.Arguments(0) & Chr(34)

WScript.QuitEnd IfWScript.Echo"正在运行,请等待......"

DimoExcel,oWorkbook,SheetOn Error Resume Next

Set oExcel = GetObject(,"Excel.Application")If Err ThenWScript.Echo Err.Description

Err.ClearSet oExcel = CreateObject("Excel.Application")

oExcel.Visible= False

End If

Set oWorkbook =oExcel.Workbooks.Open(xlsFilePath)If Err ThenErr.Clear

Wshell.Popup"无法打开指定的文件，可能的原因有：" & Chr(10) &_"1、本机没有安装Microsoft Office 2003、2007、2010或以上版本。" & Chr(10) &_"2、需要处理的文件已经打开或被其它程序占用，请关闭文件后重新使用本程序。", 10 , "提示", 16+4096WScript.QuitEnd If

On Error Goto 0

Dimfso,oFileSet fso = CreateObject("Scripting.FileSystemObject")DimstrLineDimstrArrDimCurrentPath

CurrentPath= CreateObject("Scripting.FileSystemObject").GetFile(Wscript.ScriptFullName).ParentFolder.Path

oExcel.DisplayAlerts= False

For Each Sheet InoWorkbook.Worksheets

Sheet.Select

Sheet.Activate

WScript.Echo Sheet.NameSet oFile = fso.OpenTextFile(CurrentPath & "\替换列表.txt", 1)Do While oFile.AtEndOfStream <> TruestrLine=oFile.ReadLine

strArr= Split(strLine,"→")

oExcel.Cells.Replace strArr(0), strArr(1), 2, 1, False, False, False

LoopoFile.CloseNextoWorkbook.Worksheets(1).Select

oWorkbook.Save

oExcel.DisplayAlerts= TrueoWorkbook.CloseSet oFile = Nothing

Set oExcel = Nothing

Set oWorkbook = NothingWshell.Popup"经过一段时间的浴血奋战，终于搞定了所有的单位替换。", 10, "博奥单位替换", 48