丢失对已分配数组的引用 - 下标超出范围
Losing Reference to an Assigned array - Subscript out of Range
我在主 Class(VBA 模块)中声明了一个数组。但是,我正在尝试调用一个函数,该函数本质上读取 Excel sheet,在特定的 sheet 和 returns 上查找特定的 table 定义用 Excel Table.
的内容填充的数组
我的函数似乎不想更新定义的数组。请帮忙。将定义的数组作为函数输入传递会更好吗?
代码如下:
' ----- main Module ----
'declare my Array
Dim MyArr() As Variant
Call ReadXLFileIntoArray(excelFileAddress, excelFileSheet)
Debug.Print (MyArr(1, 1)) ' raises Subscript out of range error
'- Excel Data Processing Module
Function ReadXLFileIntoArray(addr As String, sheet As Integer)
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.worksheet
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open(addr, ReadOnly:=True)
Set wks = wkb.Worksheets(sheet)
Call pushToArray(xls, wks, "excelTableName", MyArr)
wkb.Close True
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
End Function
Function pushToArray(ByRef XL As Object, ByRef wks As worksheet, tableName As String, ByRef Arr As Variant)
Dim tmpArr As Variant
Dim x As Integer, y As Integer
r = wks.ListObjects(tableName).DataBodyRange.Rows.Count - 1
c = wks.ListObjects(tableName).DataBodyRange.Columns.Count - 1
'ReDim Arr(c, r) ' do i need to call this?
tmpArr = wks.ListObjects(tableName).DataBodyRange.Value
Set Arr = XL.Transpose(tmpArr)
Debug.Print ("Loaded from Excel: " & " Records: " & wks.ListObjects(tableName).DataBodyRange.Rows.Count & "" & tableName)
Debug.Print (Arr(1, 1)) ' works!
End Function
我会这样安排:
' ----- main Module ----
Sub Tester()
Dim MyArr As Variant, excelFileAddress As String, excelFileSheet As Long
'...
'...
MyArr = ReadXLListIntoArray(excelFileAddress, excelFileSheet, "excelTableName")
Debug.Print MyArr(1, 1)
End Sub
'- Excel Data Processing Module
Function ReadXLListIntoArray(addr As String, sheet As Long, listName As String)
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open(addr, ReadOnly:=True)
ReadXLListIntoArray = wkb.Worksheets(sheet).ListObjects(listName).DataBodyRange.Value
wkb.Close False
xls.Quit
End Function
不确定您是否需要Transpose
...
我在主 Class(VBA 模块)中声明了一个数组。但是,我正在尝试调用一个函数,该函数本质上读取 Excel sheet,在特定的 sheet 和 returns 上查找特定的 table 定义用 Excel Table.
的内容填充的数组我的函数似乎不想更新定义的数组。请帮忙。将定义的数组作为函数输入传递会更好吗?
代码如下:
' ----- main Module ----
'declare my Array
Dim MyArr() As Variant
Call ReadXLFileIntoArray(excelFileAddress, excelFileSheet)
Debug.Print (MyArr(1, 1)) ' raises Subscript out of range error
'- Excel Data Processing Module
Function ReadXLFileIntoArray(addr As String, sheet As Integer)
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.worksheet
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open(addr, ReadOnly:=True)
Set wks = wkb.Worksheets(sheet)
Call pushToArray(xls, wks, "excelTableName", MyArr)
wkb.Close True
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
End Function
Function pushToArray(ByRef XL As Object, ByRef wks As worksheet, tableName As String, ByRef Arr As Variant)
Dim tmpArr As Variant
Dim x As Integer, y As Integer
r = wks.ListObjects(tableName).DataBodyRange.Rows.Count - 1
c = wks.ListObjects(tableName).DataBodyRange.Columns.Count - 1
'ReDim Arr(c, r) ' do i need to call this?
tmpArr = wks.ListObjects(tableName).DataBodyRange.Value
Set Arr = XL.Transpose(tmpArr)
Debug.Print ("Loaded from Excel: " & " Records: " & wks.ListObjects(tableName).DataBodyRange.Rows.Count & "" & tableName)
Debug.Print (Arr(1, 1)) ' works!
End Function
我会这样安排:
' ----- main Module ----
Sub Tester()
Dim MyArr As Variant, excelFileAddress As String, excelFileSheet As Long
'...
'...
MyArr = ReadXLListIntoArray(excelFileAddress, excelFileSheet, "excelTableName")
Debug.Print MyArr(1, 1)
End Sub
'- Excel Data Processing Module
Function ReadXLListIntoArray(addr As String, sheet As Long, listName As String)
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open(addr, ReadOnly:=True)
ReadXLListIntoArray = wkb.Worksheets(sheet).ListObjects(listName).DataBodyRange.Value
wkb.Close False
xls.Quit
End Function
不确定您是否需要Transpose
...