在Excel中通过Visual Basic，我正在迭代加载到Excel中的发票的CSV文件。发票由客户以可确定的模式进行。
我正在将它们读入动态2D数组，然后将它们写入带有旧发票的另一个工作表。我知道我必须反转行和列，因为只有数组的最后一个维度可能是Redimmed，然后在我将它写入主工作表时进行转置。
某处，我的语法有误。它一直告诉我，我已经对数组进行了Dimensionalized。不知怎的，我把它创建为静态数组？为了让它动态运行，我需要修复什么？
每回答工作代码
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
答案 0 :(得分：35)
这不完全是直观的，但如果你用尺寸调暗它，就不能重新(VB6 Ref)数组。链接页面的确切报价为：
ReDim语句用于调整或调整具有的动态数组的大小 已经使用Private，Public或Dim正式宣布 带有空括号的语句（没有维度下标）。
换句话说，而不是dim invoices(10,0)
你应该使用
Dim invoices()
Redim invoices(10,0)
然后当你ReDim时，你需要使用Redim Preserve (10,row)
警告：在重新定义多维数组时，如果要保留值，则只能增加最后一个维。 I.E. Redim Preserve (11,row)甚至(11,0)都会失败。
答案 1 :(得分：11)
我在遇到这个障碍时偶然发现了这个问题。我最终快速编写了一段代码，以便在新大小的数组（第一维或最后一维）上处理这个ReDim Preserve。也许它会帮助那些面临同样问题的人。
因此，对于使用情况，我们假设您的数组最初设置为MyArray(3,5)，并且您希望将尺寸（首先也是！）放大，只需对MyArray(10,20)说。你会习惯这样做吗？
ReDim Preserve MyArray(10,20) '<-- Returns Error
但遗憾的是，由于您尝试更改第一个维度的大小，因此会返回错误。所以使用我的函数，你只需要做这样的事情：
MyArray = ReDimPreserve(MyArray,10,20)
现在数组更大，数据被保留。您的多维数组的ReDim Preserve已完成。 ：）
最后但并非最不重要的是，神奇的功能：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分钟内写了这个，所以没有保证。但如果您想使用或扩展它，请随意。我会认为有人会在这里有一些像这样的代码，显然不是。所以，你可以去找其他的减速机。
答案 2 :(得分：4)
我知道这有点旧，但我认为可能有一个更简单的解决方案，不需要额外的编码：
而不是再次转置，重新调整和转置，如果我们谈论二维数组，为什么不直接存储转换后的值。在这种情况下，redim preserve实际上从一开始就增加了右（第二）维度。或者换句话说，为了使其可视化，如果只有nr列可以使用redim preserve增加，为什么不存储两行而不是两列。
索引将是00-01,01-11,02-12,03-13,04-14,05-15 ... 0 25-1 25 etcetera而不是00-01,10-11， 20-21,30-31,40-41等。
由于在重新调整时只能保留第二个（或最后一个）维度，因此可能会认为这是应该如何使用数组开始的。 我没有在任何地方看到这个解决方案，所以也许我忽略了什么？
答案 3 :(得分：3)
这里是使用variabel声明的redim preseve方法的更新代码，希望@Control Freak可以用它：）
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
答案 4 :(得分：1)
这是我的方法。
Dim TAV() As Variant
Dim ArrayToPreserve() as Variant
TAV = ArrayToPreserve
ReDim ArrayToPreserve(nDim1, nDim2)
For i = 0 To UBound(TAV, 1)
For j = 0 To UBound(TAV, 2)
ArrayToPreserve(i, j) = TAV(i, j)
Next j
Next i
答案 5 :(得分：1)
对@control怪胎和@skatun之前写的内容进行了小幅更新（对不起，我没有足够的声誉来发表评论）。我使用了skatun的代码，它对我来说很好，除了它创建的数组超出了我的需要。因此，我更改了：
try:
hp, ht, pid, tid = _winapi.CreateProcess(executable, args,
# no special security
None, None,
int(not close_fds),
creationflags,
env,
os.fspath(cwd) if cwd is not None else None,
startupinfo)
收件人：
ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound)
这将在两个维度上保持原始数组的下界（0、1或其他；原始代码假定为0）。
答案 6 :(得分：0)
我用较短的方式解决了这个问题。
Dim marray() as variant, array2() as variant, YY ,ZZ as integer
YY=1
ZZ=1
Redim marray(1 to 1000, 1 to 10)
Do while ZZ<100 ' this is populating the first array
marray(ZZ,YY)= "something"
ZZ=ZZ+1
YY=YY+1
Loop
'this part is where you store your array in another then resize and restore to original
array2= marray
Redim marray(1 to ZZ-1, 1 to YY)
marray = array2
答案 7 :(得分：0)
在这里。
Public Function ReDimPreserve(ByRef Arr, ByVal idx1 As Integer, ByVal idx2 As Integer)
Dim newArr()
Dim x As Integer
Dim y As Integer
ReDim newArr(idx1, idx2)
For x = 0 To UBound(Arr, 1)
For y = 0 To UBound(Arr, 2)
newArr(x, y) = Arr(x, y)
Next
Next
Arr = newArr
End Function
答案 8 :(得分：0)
您可以这样做array(0)= array(0,1,2,3)。
Sub add_new(data_array() As Variant, new_data() As Variant)
Dim ar2() As Variant, fl As Integer
If Not (isEmpty(data_array)) = True Then
fl = 0
Else
fl = UBound(data_array) + 1
End If
ReDim Preserve data_array(fl)
data_array(fl) = new_data
End Sub
Sub demo()
Dim dt() As Variant, nw(0, 1) As Variant
nw(0, 0) = "Hi"
nw(0, 1) = "Bye"
Call add_new(dt, nw)
nw(0, 0) = "Good"
nw(0, 1) = "Bad"
Call add_new(dt, nw)
End Sub