博奧清單匯出Excel後單位批量替換

阿新 • • 發佈：2021-01-12

博奧清單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