工作当中，有时候需要将多个excel合并成一个表格，如果表数量少手工就可以合并，遇到有大量表格就必须利用VBA代码了，但很多童鞋使用的是WPS，对VBA的支持不是很友好，推荐使用vbs脚本，以下为代码，将以下代码复制到txt文件里，然后把txt文件后缀改为vbs,双击即可运行，我来为大家科普一下关于vba工作表如何合并?下面希望有你要的答案，我们一起来看看吧!
vba工作表如何合并
工作当中，有时候需要将多个excel合并成一个表格，如果表数量少手工就可以合并，遇到有大量表格就必须利用VBA代码了，但很多童鞋使用的是WPS，对VBA的支持不是很友好，推荐使用vbs脚本，以下为代码，将以下代码复制到txt文件里，然后把txt文件后缀改为vbs,双击即可运行
dim oExcel
Set oExcel=CreateObject("Excel.Application")
file_selected= oexcel.getopenfilename ("打开表格文件*.xls;*.xlsx;*.xlsm ,*.xls;*.xlsx;*.xlsm", filterindex, "打开表格", buttontext, true)
if isarray(file_selected) Then
call heBing(file_selected)
end if
set oExcel=Nothing
wscript.quit
'-----------------以下未生存汇总表过程------------------------
sub heBing(arExport)
dim dict
set dict =createobject("scripting.dictionary")
for ai = 1 to UBound(arExport)
call openworkbook(arExport(ai),dict)
next
if dict.count>1 then
call dicZhuanArr(dict)
Else
wscript.echo "没有数据"
end if
set dict=Nothing
end sub
sub openWorkbook(path,dict)
set workbook = oExcel.workbooks.open(path)
call getsystemexcel(workbook,dict)
workbook.close
set workbook=Nothing
end sub
Sub getSystemExcel(wb,dict)
arr = wb.sheets(1).UsedRange
row = 1'默认表头从第一行开始
call head(arr,row,dict)
for a = row 1 to UBound(arr,1)
str = ""
for aa = 1 to UBound(arr,2)
str = str&"&&"&arr(a,aa)
next
str = Left(wb.name,len(wb.name)-5)&str'保留字段，表格名称，便于查错
dict.item(str)=dict.item(str) 1
next
End Sub
' 表头
Sub head(arr,row,dict)
' '表头放在字典首行
for aa = 1 to UBound(arr,2)
str = str&"&&"&arr(row,aa)
next
str = "来源"&str'保留字段表头
dict.item(str)=dict.item(str) 1
end sub
sub dicZhuanArr(dict)
dim newArr()
arr = dict.keys
Redim newArr(UBound(arr),100)
ar = Split(arr(0),"&&")
for i = 0 to UBound(arr)
for a = 0 to UBound(ar)
newArr(i,a)=Split(arr(i),"&&")(a)
next
Next
call addWorkbook(newArr)
end sub
Sub addWorkbook(ar)
Set wb = oExcel.Workbooks.Add
n = createobject("Scripting.FileSystemObject").GetFile(Wscript.ScriptFullName).ParentFolder.Path&"\"
Set wt = wb.Sheets(1)
With wt
.Range("a1").Resize(UBound(ar, 1) 1, UBound(ar, 2)) = ar
.Name = "明细"
End With
wb.SaveAs n& FormatDate(Now(),"YYYY-MM-DD hh mm ss") & ".xlsx"
wb.Close False
Set wb = nothing
End Sub
,
