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
    关注
    评论

报告相同问题?

悬赏问题

  • ¥88 找成都本地经验丰富懂小程序开发的技术大咖
  • ¥15 如何处理复杂数据表格的除法运算
  • ¥15 如何用stc8h1k08的片子做485数据透传的功能?(关键词-串口)
  • ¥15 有兄弟姐妹会用word插图功能制作类似citespace的图片吗?
  • ¥200 uniapp长期运行卡死问题解决
  • ¥15 请教:如何用postman调用本地虚拟机区块链接上的合约?
  • ¥15 为什么使用javacv转封装rtsp为rtmp时出现如下问题:[h264 @ 000000004faf7500]no frame?
  • ¥15 乘性高斯噪声在深度学习网络中的应用
  • ¥15 关于docker部署flink集成hadoop的yarn,请教个问题 flink启动yarn-session.sh连不上hadoop,这个整了好几天一直不行,求帮忙看一下怎么解决
  • ¥15 深度学习根据CNN网络模型,搭建BP模型并训练MNIST数据集