Excel VBA – 如何Redim的二维数组？
在Excel中通过Visual Basic，我通过加载到Excel中的发票CSV文件迭代。 发票是由客户确定的模式。
我将它们读入一个dynamic的二维数组，然后将它们写入另一个具有较旧发票的工作表中。 我明白，我必须扭转行和列，因为只有数组的最后一个维可能被Redimmed，然后转移，当我把它写到主工作表。
某处，我的语法错了。 它一直告诉我，我已经Dimensionalized数组。 不知何故我创build它作为一个静态数组？ 为了让它dynamic地运行，我需要解决什么问题？
工作代码每个答案给出
Sub InvoicesUpdate() ' 'Application Settings Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual 'Instantiate control variables Dim allRows As Long, currentOffset As Long, invoiceActive As Boolean, mAllRows As Long Dim iAllRows As Long, unusedRow As Long, row As Long, mWSExists As Boolean, newmAllRows As Long 'Instantiate invoice variables Dim accountNum As String, custName As String, vinNum As String, caseNum As String, statusField As String Dim invDate As String, makeField As String, feeDesc As String, amountField As String, invNum As String 'Instantiate Workbook variables Dim mWB As Workbook 'master Dim iWB As Workbook 'import 'Instantiate Worksheet variables Dim mWS As Worksheet Dim iWS As Worksheet 'Instantiate Range variables Dim iData As Range 'Initialize variables invoiceActive = False row = 0 'Open import workbook Workbooks.Open ("path:excel_invoices.csv") Set iWB = ActiveWorkbook Set iWS = iWB.Sheets("excel_invoices.csv") iWS.Activate Range("A1").Select iAllRows = iWS.UsedRange.Rows.Count 'Count rows of import data 'Instantiate array, include extra column for client name Dim invoices() ReDim invoices(10, 0) 'Loop through rows. Do 'Check for the start of a client and store client name If ActiveCell.Value = "Account Number" Then clientName = ActiveCell.Offset(-1, 6).Value End If If ActiveCell.Offset(0, 3).Value <> Empty And ActiveCell.Value <> "Account Number" And ActiveCell.Offset(2, 0) = Empty Then invoiceActive = True 'Populate account information. accountNum = ActiveCell.Offset(0, 0).Value vinNum = ActiveCell.Offset(0, 1).Value 'leave out customer name for FDCPA reasons caseNum = ActiveCell.Offset(0, 3).Value statusField = ActiveCell.Offset(0, 4).Value invDate = ActiveCell.Offset(0, 5).Value makeField = ActiveCell.Offset(0, 6).Value End If If invoiceActive = True And ActiveCell.Value = Empty And ActiveCell.Offset(0, 6).Value = Empty And ActiveCell.Offset(0, 9).Value = Empty Then 'Make sure something other than $0 was invoiced If ActiveCell.Offset(0, 8).Value <> 0 Then 'Populate individual item values. feeDesc = ActiveCell.Offset(0, 7).Value amountField = ActiveCell.Offset(0, 8).Value invNum = ActiveCell.Offset(0, 10).Value 'Transfer data to array invoices(0, row) = "=TODAY()" invoices(1, row) = accountNum invoices(2, row) = clientName invoices(3, row) = vinNum invoices(4, row) = caseNum invoices(5, row) = statusField invoices(6, row) = invDate invoices(7, row) = makeField invoices(8, row) = feeDesc invoices(9, row) = amountField invoices(10, row) = invNum 'Increment row counter for array row = row + 1 'Resize array for next entry ReDim Preserve invoices(10,row) End If End If 'Find the end of an invoice If invoiceActive = True And ActiveCell.Offset(0, 9) <> Empty Then 'Set the flag to outside of an invoice invoiceActive = False End If 'Increment active cell to next cell down ActiveCell.Offset(1, 0).Activate 'Define end of the loop at the last used row Loop Until ActiveCell.row = iAllRows 'Close import data file iWB.Close 这不完全直观，但是如果用尺寸调暗它，则不能使用Redim （VB6 Ref）数组。 来自链接页面的确切报价是：
ReDim语句用于调整或调整已经使用带空括号 （不带下标）的Private，Public或Dim语句正式声明的dynamic数组。
换句话说，不是dim invoices(10,0)
你应该使用
Dim invoices() Redim invoices(10,0)
那么当你使用ReDim时，你需要使用Redim Preserve (10,row)
警告：当Redimensioningmultidimensional array时，如果要保留值，则只能增加最后一个维度。 IE Redim Preserve (11,row)甚至(11,0)都会失败。
我自己碰到这个路障时偶然发现了这个问题。 我最终编写了一段代码，在一个新的尺寸数组（第一个或最后一个尺寸）上处理这个ReDim Preserve 。 也许它会帮助别人面对同样的问题。
所以对于这个用法，假设你的数组原来被设置为MyArray(3,5) ，并且你想要使得这个维度（第一个！）更大，那么就对MyArray(10,20) 。 你会习惯做这样的事情吗？
ReDim Preserve MyArray(10,20) '<-- Returns Error
但不幸的是，由于您尝试更改第一个维度的大小，因此会返回错误。 所以用我的function，你只需要做这样的事情：
MyArray = ReDimPreserve(MyArray,10,20)
现在数组更大，数据被保存。 您的ReDim Preservemultidimensional array已完成。 🙂
最后但并非最不重要的是，神奇的function： ReDimPreserve()
'redim preserve both dimensions for a multidimension array *ONLY Public Function ReDimPreserve(aArrayToPreserve,nNewFirstUBound,nNewLastUBound) ReDimPreserve = False 'check if its in array first If IsArray(aArrayToPreserve) Then 'create new array ReDim aPreservedArray(nNewFirstUBound,nNewLastUBound) 'get old lBound/uBound nOldFirstUBound = uBound(aArrayToPreserve,1) nOldLastUBound = uBound(aArrayToPreserve,2) 'loop through first For nFirst = lBound(aArrayToPreserve,1) to nNewFirstUBound For nLast = lBound(aArrayToPreserve,2) to nNewLastUBound 'if its in range, then append to new array the same way If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then aPreservedArray(nFirst,nLast) = aArrayToPreserve(nFirst,nLast) End If Next Next 'return the array redimmed If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray End If End Function
我用20分钟写了这个，所以没有保证。 但是，如果您想使用或扩展它，请随时取消。 我本来以为有人会在这里有这样的代码，显然不是。 所以，在这里，你去同胞减速机。
这里是更新代码的redim preseve方法与heterobel声明，希望@控制怪胎是好的:)
Option explicit 'redim preserve both dimensions for a multidimension array *ONLY Public Function ReDimPreserve(aArrayToPreserve As Variant, nNewFirstUBound As Variant, nNewLastUBound As Variant) As Variant Dim nFirst As Long Dim nLast As Long Dim nOldFirstUBound As Long Dim nOldLastUBound As Long ReDimPreserve = False 'check if its in array first If IsArray(aArrayToPreserve) Then 'create new array ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound) 'get old lBound/uBound nOldFirstUBound = UBound(aArrayToPreserve, 1) nOldLastUBound = UBound(aArrayToPreserve, 2) 'loop through first For nFirst = LBound(aArrayToPreserve, 1) To nNewFirstUBound For nLast = LBound(aArrayToPreserve, 2) To nNewLastUBound 'if its in range, then append to new array the same way If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then aPreservedArray(nFirst, nLast) = aArrayToPreserve(nFirst, nLast) End If Next Next 'return the array redimmed If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray End If End Function