使用vbscript替换excel文件的内容

这个不能算瞎折腾，也算是被逼的没办法了。从接手webgame开始，看到那么多的excel文件被翻译为繁体，我的头就没小过。现在因为新版本的问题又得重新翻译一次，经历过上一次惨痛的过程，这一次变懒了。

 

大陆内地使用的是简体中文，台湾地区使用的是繁体中文，我们将游戏中用到的配置和所有需要汉化的文字提供给台湾合作伙伴，他们翻译后再回传给我们。实际上面对那么大的工程，是不可能所有内容都一个一个去看的，所以采用的是word或是excel自动的简转繁功能，但这样的方式带来了比较致命的问题，合作方往往在你重新生成配置文件后，测试过程中发现一些文字需要重新替换，出现这种情况的原因主要是在于台湾地区的方言和大陆所使用的描述不一样。比如“充值” –> “储值”、“信息”-> “訊息”、“设置”->“設定”等等，很多…，还有就是一段任务的描述，对方在测试时也觉得要进行修改、调整，这个时候也得重新生成，然后打包、上传、更新版本号…

 

之前因为这个，曾经用.net写过一个查找指定文件夹下所有文件（包含excel）的小应用程序，检测后生成一个html，里面重点标识出匹配到输入文字的文件（支持点击打开该文件）。现在是先让对方提供一个转换库，比如上面说的，然后写程序将所有需要检测的文件进行替换（重点是excel），因为游戏中需要用到的excel文件异常多，近200个左右。数量倒不是很大，但重点是一个excel中的某一个sheet可能就超过1万行的数据了。

 

最初想法是觉得很简单，只是替换而已，就想用php去做这件事，可到后来发现php使用phpexcel这个库对excel读取的时候，遇到中文，特别是繁体中文时问题多多，基本上不能读取完一个文件夹下的excel文件，自行中断了。然后想想说用vbs写个程序吧，毕竟有近200个文件呢，不太想写个宏，然后把一百多个文件打开都来执行一个这个宏命令。

 

写的时候遇到了一些问题，比如在切换写javascript、vbscript和actionscript的时候容易犯小错误，二就是对vbscript操作dom不熟悉，三就是需要找到可以让循环在跑的过程中能sleep，因为文件过多，循环无法避免而且是很漫长的过程，必须要用到sleep。写是写完了，不过整个跑的效果并不理想：太慢…

 

假设平均一个excel文件为 15列 * 10000行，如今有超过185个这样的excel文件，那么大约有 27,750,000(近三千万次循环)，不包含读取文件，以及循环再去替换它的内容然后写入内容的操作。下一步是要优化这个工具，因为以后它会被经常用到，先放一下工具大致实现(使用的是hta，可以本地直接运行)

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html>
<head>
<title>Excel VBA正则表达式替换</title>
<meta http-equiv="content-type" content="text/html;charset=utf-8" />
<hta:application id="appGTJExcel" applicationname="appGTJExcel" singleinstance="yes" border="thin" scroll="no" maximizeButton="no">
<style type="text/css">
<style type="text/css">
*{margin:0; padding:0;}
body {font-size:14px; background-color:#eee; width:100%; height:100%; overflow:hidden;}

.exec-btn {display:block; border:1px solid #666; background-color:#9c0; color:#360; padding:5px 5px 3px 5px; width:70px; height:30px; vertical-align:middle; cursor:pointer;}

fieldset {height:440px; width:1050px; margin-top:20px; display:block;}
legend {margin-left:20px; display:none;}

#container {height:100%; overflow:auto; list-style-type: none;}
#container li {height:20px; line-height:20px; overflow:hidden; vertical-align:middle; margin:10px 10px 10px 0;}

.red {color:#ff0000;}
</style>
</head>
<body>

<button class="exec-btn" onclick="replaceHandler()">开始替换</button>

<fieldset>
    <legend>VBS替换内容</legend>
    <ul id="container">
        <li>点击开始执行替换操作</li>
    </ul>
</fieldset>

<script language="javascript">
   1:  
   2:     function getEl(id) {
   3:         return typeof id === 'string' ? document.getElementById(id) : id;
   4:     }
   5:  
   6:     function addMessage(msg) {
   7:         var li = document.createElement("li");
   8:             li.innerHTML = msg;
   9:         
  10:         getEl("container").appendChild(li);
  11:     }
  12:  
  13:     function replaceStr(str) {
  14:         var arr = [],
  15:             newArr = [];
  16:  
  17:         arr = [
  18:                 '将要被替换的文字'
  19:             ];
  20:  
  21:         newArr = [
  22:                '被替换后的文字，与arr数组对应的元素一对一'
  23:         ];
  24:  
  25:         for (var i = 0, len = arr.length; i < len; ++i) {
  26:             str = str.replace(new RegExp(arr[i], "g"), newArr[i]);
  27:         }
  28:  
  29:         return str;
  30:     }
</script>
   1:  
   2:  
   3: <script language="vbscript">
   4: '函数   返回类型   expression   参数范围   
   5: 'CBool     Boolean   任何有效的字符串或数值表达式。   
   6: 'CByte     Byte   0   至   255。   
   7: 'CCur   Currency   -922,337,203,685,477.5808   至922,337,203,685,477.5807。   
   8: 'CDate   Date   任何有效的日期表达式。   
   9: 'CDbl   Double     负数从   -1.79769313486232E308   至   -4.94065645841247E-324；正数从   4.94065645841247E-324   至   1.79769313486232E308。   
  10: 'CDec   Decimal   零变比数值，即无小数位数值，为   
  11: '+/-79,228,162,514,264,337,593,543,950,335。对于   28   位小数的数值，范围则为   
  12: '+/-7.9228162514264337593543950335；最小的可能非零值是   0.0000000000000000000000000001。   
  13: 'CInt   Integer   -32,768   至   32,767，小数部分四舍五入。   
  14: 'CLng   Long   -2,147,483,648   至   2,147,483,647，小数部分四舍五入。   
  15: 'CSng   Single   负数为   -3.402823E38   至   -1.401298E-45；正数为   1.401298E-45   至   3.402823E38。   
  16: 'CStr   String   依据   expression   参数返回   Cstr。   
  17:  
  18: Option Explicit
  19: 'On Error Resume Next
  20:  
  21: Dim folderPath, folder
  22: Dim fso, file, files
  23: Dim fileNums
  24: Dim FileString()
  25: Dim re
  26: Dim i
  27:  
  28: folderPath = "D:\excel\...."
  29: i = 0
  30:  
  31: Set fso = CreateObject("Scripting.FileSystemObject")
  32:  
  33:  
  34: '执行替换操作
  35: Sub replaceHandler()
  36:     
  37:     If fso.FolderExists(folderPath) Then
  38:         Set folder = fso.GetFolder(folderPath)
  39:         Set files = folder.Files
  40:         fileNums = files.Count
  41:         
  42:         Call addMessage("目录“"+folderPath+"”下的总文件数：<strong class='red'>" + CStr(fileNums) + "</strong>个")
  43:         
  44:         Set re = new RegExp
  45:             re.Pattern = ".xlsx$"
  46:             re.Global = True
  47:             re.ignoreCase = false
  48:  
  49:         For Each file In files
  50:             If re.test(file.name) Then 
  51:                 i=i+1
  52:                 Call addMessage(CStr(i) + "--" + file.name)
  53:                 replaceExcel(folderPath + "\" + file.name)
  54:             End If
  55:             Sleep(3*1000)
  56:  
  57:             'Exit For
  58:  
  59:         Next
  60:  
  61:         MsgBox "所有文件已处理完成", 64, "温馨提示" 
  62:     Else
  63:         Msgbox "指定的目录“" + folderPath + "”不是一个文件夹" 
  64:     End If
  65:  
  66: End Sub
  67:  
  68:  
  69:  
  70:  
  71: Sub replaceExcel(filePath)
  72:     Dim objExcel
  73:     Dim excelBook
  74:     Dim objSheet
  75:  
  76:     Set objExcel = CreateObject("Excel.Application")
  77:     Set    excelBook = objExcel.Workbooks.Open(filePath)
  78:     Set objSheet = excelBook.Worksheets(1)
  79:     
  80:     '不弹出是否保存excel或是取消操作
  81:     objExcel.DisplayAlerts = False 
  82:  
  83:     Dim cols
  84:     Dim rows
  85:  
  86:     cols = objSheet.UsedRange.Cells.Columns.Count
  87:     rows = objSheet.UsedRange.Cells.Rows.Count
  88:  
  89:     addMessage("文件<a href='"+filePath+"'>"+filePath+"</a>　　活动区有:<strong class='red'>" & cols & "</strong>列 <strong class='red'>" & rows & "</strong>行")
  90:     
  91:     Dim i,j,s
  92:  
  93:     i = 1
  94:     j = 1
  95:     Do While i <= rows
  96:         j = 1
  97:         Do While j <= cols            
  98:             s = objSheet.Cells(i, j).Value
  99:             s = CStr(s)
 100:             
 101:             If Len(s) > 1 Then 
 102:                 objSheet.Cells(i, j).Value = replaceStr(s)
 103:         
 104:             'Call addMessage((i+1) & "行" & (j+1) & "列：" + s + "---" + replaceStr(s))
 105:             End If
 106:             j = j + 1
 107:         Loop
 108:         Sleep(100)
 109:         i = i + 1
 110:     Loop
 111:  
 112:     'Close workbook and quit Excel.
 113:     'excelBook.SaveAs "d:\test.xls" '保存工作表
 114:     'excelBook.Close
 115:  
 116:     objExcel.ActiveWorkbook.Save
 117:     objExcel.ActiveWorkbook.Close
 118:     objExcel.Application.Quit
 119:     
 120:     Set objExcel = Nothing
 121:     Set    excelBook = Nothing
 122:     Set    objSheet = Nothing
 123:  
 124: End sub
 125:  
 126:  
 127: Sub Sleep(MSecs)  
 128:     Dim fso
 129:     Dim objOutputFile
 130:  
 131:     Set fso = CreateObject("Scripting.FileSystemObject") 
 132:     If Fso.FileExists("sleeper.vbs")=False Then 
 133:         Set objOutputFile = fso.CreateTextFile("sleeper.vbs", True) 
 134:         objOutputFile.Write "wscript.sleep WScript.Arguments(0)" 
 135:         objOutputFile.Close 
 136:     End If 
 137:     CreateObject("WScript.Shell").Run "sleeper.vbs " & MSecs,1 , True 
 138: End Sub 
 139:  
 140: '"Automation服务器不能创建对象" 的多种解决办法
 141: 'http://www.cnblogs.com/BTQ/archive/2008/05/29/1209738.html
</script>

</body>
</html>

 

运行起来的效果图大致如下图所示：

image

posted @ 2011-08-30 23:04  meteoric_cry  阅读(1875)  评论(0)  编辑  收藏  举报