QWE1689664465 2018-04-19 05:02 采纳率: 0%
浏览 1732
已结题

下面这段(合并excel表)代码运行中出现下标越界,为什么

Sub Collectwk2()
'ExcelHome VBA编程学习与实践
Dim Trow&, k&, arr, brr, i&, j&, book&, a&
Dim p$, f$, Rng As Range
With Application.FileDialog(msoFileDialogFolderPicker)
'取得用户选择的文件夹路径
.AllowMultiSelect = False
If .Show Then p = .SelectedItems(1) Else Exit Sub
End With
If Right(p, 1) <> "\" Then p = p & "\"
'
Trow = Val(InputBox("请输入标题的行数", "提醒"))
If Trow < 0 Then MsgBox "标题行数不能为负数。", 64, "警告": Exit Sub
Application.ScreenUpdating = False '关闭屏幕更新
Cells.ClearContents '清空当前表数据
Cells.NumberFormat = "@" '设置单元格格式为文本
ReDim brr(1 To 200000, 1 To 1)
'定义装汇总结果的数组brr,最大行数为20万行
f = Dir(p & "*.xls*")
'开始遍历指定文件夹路径下的每个工作簿
Do While f <> ""
If f <> ThisWorkbook.Name Then '避免同名文件重复打开出错
With GetObject(p & f)
'以\'只读\'形式读取文件时,使用getobject方法会比workbooks.open稍快
Set Rng = .Sheets(1).UsedRange
If IsEmpty(Rng) = False Then '如果工作表非空
book = book + 1 '标记一下是否首个Sheet,如果首个sheet,BOOK=1
a = IIf(book = 1, 1, Trow + 1) '遍历读取arr数组时是否扣掉标题行
arr = Rng.Value '数据区域读入数组arr
If UBound(arr, 2) > UBound(brr, 2) Then
'动态调整结果数组brr的最大列数,避免明细表列数不一的情况。
ReDim Preserve brr(1 To 200000, 1 To UBound(arr, 2))
End If
For i = a To UBound(arr) '遍历行
k = k + 1 '累加记录条数
For j = 1 To UBound(brr, 2) '遍历列
brr(k, j) = arr(i, j)
Next
Next
End If
.Close False '关闭工作簿,不保存。
End With
End If
f = Dir '下一个工作簿
Loop
If k > 0 Then
[a1].Resize(k, UBound(brr, 2)) = brr
MsgBox "汇总完成。"
End If
Application.ScreenUpdating = True '恢复屏幕更新
End Sub

  • 写回答

1条回答 默认 最新

  • dabocaiqq 2018-04-19 05:46
    关注
    评论

报告相同问题?

悬赏问题

  • ¥15 如何在scanpy上做差异基因和通路富集?
  • ¥20 关于#硬件工程#的问题,请各位专家解答!
  • ¥15 关于#matlab#的问题:期望的系统闭环传递函数为G(s)=wn^2/s^2+2¢wn+wn^2阻尼系数¢=0.707,使系统具有较小的超调量
  • ¥15 FLUENT如何实现在堆积颗粒的上表面加载高斯热源
  • ¥30 截图中的mathematics程序转换成matlab
  • ¥15 动力学代码报错,维度不匹配
  • ¥15 Power query添加列问题
  • ¥50 Kubernetes&Fission&Eleasticsearch
  • ¥15 報錯:Person is not mapped,如何解決?
  • ¥15 c++头文件不能识别CDialog