[已解决]VBA汇总求助 7.22补充提问

eggcheng · 发表于 2015-7-20 10:23

本帖最后由 eggcheng 于 2015-7-22 08:32 编辑

求老师们帮我写段代码，将同个文件夹下所有excel表的数据汇总到一个工作表中，万分感谢

老师帮我写的代码还有点需要修改的，文本与数值，现在生成的汇总格式全部是数值，像AL列的报关单号码就显示不完整，可否修改成源文件是文本查过来就是文本，源文件是数值就是数值，谢谢！

最佳答案

月排行榜 / 总排行榜

qh8600

2015-7-20 11:09

Sub demo()
Dim ar, br, str, i, j, n
Application.DisplayAlerts = False
Application.ScreenUpdating = False
FilePath = ThisWorkbook.Path & ""
str = Dir(FilePath & "*.xls", vbNormal)
ReDim br(1 To 100000, 1 To 107)
Do While str <> ""
If str <> "汇总格式.xls" Then
Workbooks.Open FilePath & str
With Workbooks(2)
ar = .Sheets("入出境信息").Range("A1").CurrentRegion
.Close savechange = True
End With
For i = 3 To UBound(ar)
n = n + 1
For j = 1 To UBound(ar, 2)
br(n, j) = ar(i, j)
Next
Next
End If
str = Dir
Loop
Range("a2").Resize(n, 107) = br
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

复制代码

求助.rar (116.8 KB, 下载次数: 14)

qh8600 · 发表于 2015-7-20 11:09

这个最佳答案由 qh8600 给出，感谢 qh8600 的回答。

单击隐藏图章

Sub demo()
Dim ar, br, str, i, j, n
Application.DisplayAlerts = False
Application.ScreenUpdating = False
FilePath = ThisWorkbook.Path & ""
str = Dir(FilePath & "*.xls", vbNormal)
ReDim br(1 To 100000, 1 To 107)
Do While str <> ""
If str <> "汇总格式.xls" Then
Workbooks.Open FilePath & str
With Workbooks(2)
ar = .Sheets("入出境信息").Range("A1").CurrentRegion
.Close savechange = True
End With
For i = 3 To UBound(ar)
n = n + 1
For j = 1 To UBound(ar, 2)
br(n, j) = ar(i, j)
Next
Next
End If
str = Dir
Loop
Range("a2").Resize(n, 107) = br
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

复制代码

求助.rar (116.8 KB, 下载次数: 14)

eggcheng · 发表于 2015-7-20 11:41

qh8600 发表于 2015-7-20 11:09

运行错误9，下标越界

qh8600 · 发表于 2015-7-20 11:48

eggcheng 发表于 2015-7-20 11:41
运行错误9，下标越界

关闭其他工作簿，只打开一个汇总的

eggcheng · 发表于 2015-7-21 16:30

qh8600 发表于 2015-7-20 11:48
关闭其他工作簿，只打开一个汇总的

可以了多谢老师~

eggcheng · 发表于 2015-7-22 08:31

qh8600 发表于 2015-7-20 11:48
关闭其他工作簿，只打开一个汇总的

老师麻烦再帮我修改一下数据类型

		自动登录	找回密码
密码			注册