博奥清单导出Excel后单位批量替换

博奥清单V17中，单位平方米和立方米的数字均为上标显示。为使打印出来后易于分辨，应BOSS要求，在导出Excel后将其修改为“m2”和“m3”。

VBS批量修改代码：

Option Explicit

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

Dim xlsFilePath
xlsFilePath=WScript.Arguments(0)

Dim Wshell
Set Wshell=CreateObject("Wscript.Shell")

If LCase(Right(WScript.FullName,11)) = "wscript.exe" Then
    Wshell.Run "CScript.exe //nologo" & _
    Chr(32) & _
    Chr(34) & WScript.ScriptFullName & Chr(34) & _
    Chr(32) & _
    Chr(34) & WScript.Arguments(0) & Chr(34)
    WScript.Quit
End If

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

Dim oExcel,oWorkbook,Sheet
On Error Resume Next
Set oExcel = GetObject(,"Excel.Application")
If Err Then
    WScript.Echo Err.Description
    Err.Clear
    Set oExcel = CreateObject("Excel.Application")
    oExcel.Visible = False
End If
Set oWorkbook = oExcel.Workbooks.Open(xlsFilePath)
If Err Then
    Err.Clear
    Wshell.Popup "无法打开指定的文件，可能的原因有：" & Chr(10) & _
    "1、本机没有安装Microsoft Office 2003、2007、2010或以上版本。" & Chr(10) & _
    "2、需要处理的文件已经打开或被其它程序占用，请关闭文件后重新使用本程序。", 10 , "提示", 16+4096
    WScript.Quit
End If
On Error Goto 0
oExcel.DisplayAlerts = False

Dim CurrentPath
CurrentPath = CreateObject("Scripting.FileSystemObject").GetFile(Wscript.ScriptFullName).ParentFolder.Path
For Each Sheet In oWorkbook.Worksheets
    Sheet.Activate
    Wscript.Echo "Replace:" & Sheet.Name
    oExcel.Cells.Replace "㎡", "m2", 2, 1, False, False, False
    oExcel.Cells.Replace "", "m2", 2, 1, False, False, False
    oExcel.Cells.Replace "", "m3", 2, 1, False, False, False
    oExcel.Cells.Replace "延长米", "m", 2, 1, False, False, False
Next
oWorkbook.Worksheets(1).Select
oWorkbook.Save
oExcel.DisplayAlerts = True
oWorkbook.Close

Set oExcel = Nothing
Set oWorkbook = Nothing

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

 VBS批量修改代码（读取“替换列表.txt”文件，循环替换）

Option Explicit

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

Dim xlsFilePath
xlsFilePath=WScript.Arguments(0)

Dim Wshell
Set Wshell=CreateObject("Wscript.Shell")

If LCase(Right(WScript.FullName,11)) = "wscript.exe" Then
    Wshell.Run "CScript.exe //nologo" & _
    Chr(32) & _
    Chr(34) & WScript.ScriptFullName & Chr(34) & _
    Chr(32) & _
    Chr(34) & WScript.Arguments(0) & Chr(34)
    WScript.Quit
End If

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

Dim oExcel,oWorkbook,Sheet

On Error Resume Next

Set oExcel = GetObject(,"Excel.Application")
If Err Then
    WScript.Echo Err.Description
    Err.Clear
    Set oExcel = CreateObject("Excel.Application")
    oExcel.Visible = False
End If

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

On Error Goto 0

Dim fso,oFile
Set fso = CreateObject("Scripting.FileSystemObject")

Dim strLine
Dim strArr

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

oExcel.DisplayAlerts = False
For Each Sheet In oWorkbook.Worksheets
    Sheet.Select
    Sheet.Activate
    WScript.Echo Sheet.Name
    Set oFile = fso.OpenTextFile(CurrentPath & "\替换列表.txt", 1)
    Do While oFile.AtEndOfStream <> True
        strLine = oFile.ReadLine
        strArr = Split(strLine,"→")
        oExcel.Cells.Replace strArr(0), strArr(1), 2, 1, False, False, False
    Loop
    oFile.Close
Next
oWorkbook.Worksheets(1).Select
oWorkbook.Save
oExcel.DisplayAlerts = True
oWorkbook.Close

Set oFile = Nothing
Set oExcel = Nothing
Set oWorkbook = Nothing

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

“替换列表.txt”样例：

古民居04号→04号古民居(罗满才)修缮工程
古民居05号→05号古民居(邓耀柱)修缮工程
古民居06号→06号古民居修缮工程
古民居09号→09号古民居修缮工程
古民居11号→11号古民居(邓耀梓)修缮工程
古民居12号→12号古民居(邓秋阳)修缮工程
古民居13号→13号古民居(邓亚贵)修缮工程
古民居15号→15号古民居修缮工程
古民居18号→18号古民居修缮工程
古民居19号→19号古民居(邓国天)修缮工程
古民居27号→27号古民居(邓耀梓祖屋)修缮工程
古民居28号→28号古民居修缮工程
古民居29号→29号古民居修缮工程
古民居31号→31号古民居(邓耀梓)修缮工程
古民居32号→32号古民居修缮工程
古民居33号→33号古民居(廖家祖屋)修缮工程
古民居34号→34号古民居(罗家祖屋)修缮工程
古民居35号→35号古民居(罗家祖屋)修缮工程
古民居36号→36号古民居(罗家祖屋)修缮工程
古民居37号→37号古民居(罗家祖屋)修缮工程
古民居38号→38号古民居(杨家祖屋)修缮工程
闸门01→闸门一修缮工程
闸门02→闸门二修缮工程
闸门03→闸门三修缮工程
闸门04→闸门四修缮工程
闸门05→闸门五修缮工程
闸门06→闸门六(廖家闸门)修缮工程
闸门07→闸门七(罗家闸门)修缮工程
闸门08→闸门八(二闸)修缮工程
闸门09→闸门九(大闸)修缮工程
闸门10→闸门十修缮工程
闸门11→闸门十一修缮工程
闸门12→闸门十二修缮工程
闸门13→闸门十三修缮工程
金石庙→金石庙修缮工程
木村坡围墙→围墙修缮工程
木村坡铺张→木村坡铺装
木村坡寨墙→寨墙
木村坡牌楼→入口牌坊
木村坡排水→雨水
木村坡污水→污水
木村坡照明→强电
木村坡雨水→雨水
㎡→m2
→m2
→m3