redim preserve 数组时显示下标越界，请指教

boping_wu · 发表于 2015-9-14 00:32

'获取文件名的方法之一：Dir函数

'获得某个文件夹下的某类扩展名文件Name 和 Path，结果生成一个二维数组

Function getfileinfo(Folderpath As String)
Dim file_info() As String
Dim i%
Filename = Dir(Folderpath)

If Filename = "" Then
      MsgBox "No files!"
      file_info(1, 1) = ""
      Exit Function
End If

i = 0
Do While Filename <> ""
      i = i + 1
      ReDim Preserve file_info(1 To i, 1 To 2) As String
      file_info(i, 1) = Filename
      file_info(i, 2) = Folderpath
      Filename = Dir

Loop
getfileinfo = file_info
MsgBox "共有" & i & "个文件"

End Function

Sub test()
Dim newrow%, newcol%
Dim arr
arr = getfileinfo(ThisWorkbook.Path & "\")
newrow = UBound(arr)
newcol = UBound(arr, 2)
ThisWorkbook.Worksheets(1).Range(Cells(2, 2), Cells(1 + newrow, 1 + newcol)) = getfileinfo(ThisWorkbook.Path & "\")
End Sub

wormtwo · 发表于 2015-9-14 06:02

   ReDim Preserve file_info(1 To i, 1 To 2) As String
      file_info(i, 1) = Filename
      file_info(i, 2) = Folderpath

红色地方改成
   ReDim Preserve file_info(1 To 2, 1 To i) As String
      file_info(1, i) = Filename
      file_info(2, i) = Folderpath

huang1314wei · 发表于 2015-9-14 06:47

ReDim Preserve只能改变数组最末维大小

boping_wu · 发表于 2015-9-14 21:59

huang1314wei 发表于 2015-9-14 06:47
ReDim Preserve只能改变数组最末维大小

谢谢了，朋友

jaxxcyh · 发表于 2024-8-5 08:38

也就是对于二维数组，redim时只能横向扩展（扩充列数），不能纵向延伸（增加行数）。确实需要纵向延伸第一维，可以用转置命令transpose帮忙，把横向扩展后的数组转置一下就变成了一个纵向延伸的数组了。

Sub test()
Dim arr(), brr()
ReDim arr(1 To 10, 1 To 2) '10行2列的数组
For i = 1 To 10
For j = 1 To 2
arr(i, j) = i & "," & j
Next
Next
brr = Application.Transpose(arr) '转置为2行10列的数组
ReDim Preserve brr(1 To 2, 1 To 20) '扩充brr的列数到20列
arr = Application.Transpose(brr) '再转为20行2列放回原数组
For i = 11 To 20 '又可以愉快的蹦哒了
For j = 1 To 2
arr(i, j) = i & "," & j
Next
Next
[a1].Resize(20, 2).Value = arr
End Sub

复制代码

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

[求助] redim preserve 数组时显示下标越界，请指教