求大神幫幫忙幫寫個代碼具體要求如下：
在一個檔案夾下有若干個 txt和 excel表格如圖1
把圖3 excel的 I列工資轉化為數值
寫入圖2 txt里對應人員最后0.00那一列（ txt和 excel里的身份證號都是唯一沒有重復的）
uj5u.com熱心網友回復：
寫好了,代碼如下:
Set dict = createobject("scripting.dictionary")
Set fso = createobject("scripting.filesystemobject")
curdir = fso.getparentfoldername(wscript.scriptfullname)
Set objfolder = fso.getfolder(curdir)
Set reg = createobject("vbscript.regexp")
reg.Global = True
reg.multiline = True
reg.ignorecase = True
reg.pattern = "^(\S*\t)(\S*)(\t\S*\t\S*\t\S*\t\S* ?\t)\S*.*$"
Set excel = createobject("excel.application")
excel.visible = True
For Each objfile In objfolder.files
If StrComp(fso.getextensionname(objfile.name),"xlsx",1) = 0 Then
Set wb = excel.workbooks.open(objfile.path)
i = 4
Set ws = wb.sheets(1)
While ws.cells(i,"F") <> ""
dict.add CStr(ws.cells(i,"F")), CStr(ws.cells(i,"I"))
i = i + 1
Wend
wb.close
End If
Next
excel.quit
For Each objfile In objfolder.files
If StrComp(fso.getextensionname(objfile.name),"txt",1) = 0 Then
Set stream = fso.opentextfile(objfile.path,1,False)
content = stream.readall
stream.close
Set stream = fso.opentextfile(objfile.path,2,True)
Set colmatches = reg.execute(content)
For Each objmatch In colmatches
If dict.exists(objmatch.submatches(1)) Then
stream.writeline objmatch.submatches(0) & objmatch.submatches(1) & objmatch.submatches(2) & FormatNumber(dict(objmatch.submatches(1)),2,-2,-2,0)
Else
stream.write objmatch.value
End If
Next
stream.close
End If
Next
msgbox "done!"
下載地址:
鏈接：https://pan.baidu.com/s/1xmKHrlnn8Z1mLkhafw5c5w
提取碼：jl2z
uj5u.com熱心網友回復：
這個只支持xlsx格式，不支持xls格式
uj5u.com熱心網友回復：
修改了一下:
Set dict = createobject("scripting.dictionary")
Set fso = createobject("scripting.filesystemobject")
curdir = fso.getparentfoldername(wscript.scriptfullname)
Set objfolder = fso.getfolder(curdir)
Set reg = createobject("vbscript.regexp")
reg.Global = True
reg.multiline = True
reg.ignorecase = True
reg.pattern = "^(\S*\t)(\S*)(\t\S*\t\S*\t\S*\t\S* ?\t)\S*.*$"
Set excel = createobject("excel.application")
excel.visible = True
For Each objfile In objfolder.files
If StrComp(Left(fso.getextensionname(objfile.name),3),"xls",1) = 0 Then
Set wb = excel.workbooks.open(objfile.path)
i = 4
Set ws = wb.sheets(1)
While ws.cells(i,"F") <> ""
dict.add UCase(CStr(ws.cells(i,"F"))), CStr(ws.cells(i,"I"))
i = i + 1
Wend
wb.close
End If
Next
excel.quit
For Each objfile In objfolder.files
If StrComp(fso.getextensionname(objfile.name),"txt",1) = 0 Then
Set stream = fso.opentextfile(objfile.path,1,False)
content = stream.readall
stream.close
Set stream = fso.opentextfile(objfile.path,2,True)
Set colmatches = reg.execute(content)
For Each objmatch In colmatches
If dict.exists(UCase(objmatch.submatches(1))) Then
stream.writeline objmatch.submatches(0) & objmatch.submatches(1) & objmatch.submatches(2) & FormatNumber(dict(objmatch.submatches(1)),2,-2,-2,0)
Else
stream.write objmatch.value
End If
Next
stream.close
End If
Next
msgbox "done!"
下載地址:
鏈接：https://pan.baidu.com/s/18UjHEyliraLW_cwYpuy_ug
提取碼：k1le
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/16808.html
標籤：VBA
上一篇：【求助帖】VBA代碼報錯invalid procedure call or argument 麻煩大佬們幫忙看一下