目標 - 將多個 Excel 檔案中的多個二維陣列組合成單個二維陣列。我是第一次編碼和 VBA。
Sub RangeToArray()
Dim s As String, MyFiles As String
Dim i As Long, j As Long, r As Long, m As Long, n As Long
Dim dArray() As Variant, fArray() As Variant
Dim wb As Workbook, rng As Range
MyFiles = "path"
s = Dir(MyFiles & "*.xls")
Do While s <> ""
ReDim fArray(ubounddArray1, ubounddArray2)
Set wb = Workbooks.Open(MyFiles & s, False, True)
Set rng = wb.Sheets(1).Range("A1:B2")
dArray = rng.Value
uboundfArray1 = UBound(fArray, 1)
uboundfArray2 = UBound(fArray, 2)
ubounddArray1 = UBound(dArray, 1)
ubounddArray2 = UBound(dArray, 2)
ReDim Preserve fArray(uboundfArray1, uboundfArray2 bounddArray2 1)
For m = LBound(dArray, 1) To UBound(dArray, 1)
For n = LBound(dArray, 2) To UBound(dArray, 2)
fArray(m, uboundfArray2 n) = dArray(m, n)
Next n
Next m
wb.Close SaveChanges:=False
s = Dir
Loop
不要作業。寫入運行時錯誤“9”：下標超出范圍。
uj5u.com熱心網友回復：
未經測驗，但這可能是一種方法：
Sub RangeToArray()
Dim s As String, MyFiles As String
Dim fArray() As Variant, arr, i As Long
Dim numRows As Long, numCols As Long, r As Long, c As Long, rT As Long
Dim wb As Workbook, colArrays As Collection
Application.DisplayAlerts = False
Application.ScreenUpdating = False
MyFiles = "C:\Users\User\Desktop\Nezavisimai\Papka2\"
s = Dir(MyFiles & "*.xls")
Set colArrays = New Collection
Do While s <> ""
With Workbooks.Open(MyFiles & s, False, True)
colArrays.Add .Sheets(1).Range("A1:B2").Value 'add array to collection
.Close False
End With
s = Dir
Loop
numRows = UBound(colArrays(1), 1)
numCols = UBound(colArrays(1), 2) 'edit:fixed typo
ReDim fArray(1 To (numRows*colArrays.Count), 1 to numCols)
rT = 0
'loop over collection and add each item to the final array
For Each arr In colArrays
For r = 1 To numRows
rT = rT 1
For c = 1 To numCols
fArray(rT, c) = arr(r, c)
Next c
Next r
Next arr
Worksheets("Insert").Range("A1") _
.Resize(UBound(fArray, 1), UBound(fArray, 2)).Value = fArray
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/372752.html
標籤：vba
上一篇：洗掉表中的過濾行而不是整行