Excel VBA -如何重拨2D数组?

In Excel via Visual Basic, I am iterating through a CSV file of invoices that is loaded into Excel. The invoices are in a determinable pattern by client.

在Visual Basic的Excel中，我正在迭代一个包含发票的CSV文件，并将其加载到Excel中。发票由客户确定。

I am reading them into a dynamic 2D array, then writing them to another worksheet with older invoices. I understand that I have to reverse rows and columns since only the last dimension of an array may be Redimmed, then transpose when I write it to the master worksheet.

我将它们读入一个动态的2D数组，然后将它们写入另一个带有旧发票的工作表中。我理解我必须反向行和列，因为只有数组的最后一个维度可以重命名，然后当我把它写到主工作表时再转置。

Somewhere, I have the syntax wrong. It keeps telling me that I have already Dimensionalized the array. Somehow did I create it as a static array? What do I need to fix in order to let it operate dynamically?

在某个地方，我有语法错误。它一直告诉我，我已经对数组进行了维度化。不知何故，我将它创建为一个静态数组?为了让它动态运行，我需要修正什么?

WORKING CODE PER ANSWER GIVEN

给出每个答案的工作代码

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

4 个解决方案

#1

This isn't exactly intuitive, but you cannot Redim(VB6 Ref) an array if you dimmed it with dimensions. Exact quote from linked page is:

这并不完全是直观的，但是如果您使用维度来调暗数组，就不能重拨(VB6 Ref)。链接页面的准确报价为:

The ReDim statement is used to size or resize a dynamic array that has already been formally declared using a Private, Public, or Dim statement with empty parentheses (without dimension subscripts).

ReDim语句用于调整动态数组的大小或大小，这些动态数组已经使用带有空括号(没有维下标)的私有、公共或Dim语句正式声明。

In other words, instead of dim invoices(10,0)

换句话说，不是dim发票(10,0)

You should use

你应该使用

Dim invoices()
Redim invoices(10,0)

Then when you ReDim, you'll need to use Redim Preserve (10,row)

当你重拨时，你需要使用重拨保存(10，行)

Warning: When Redimensioning multi-dimensional arrays, if you want to preserve your values, you can only increase the last dimension. I.E. Redim Preserve (11,row) or even (11,0) would fail.

警告:在重定多维数组的尺寸时，如果希望保留值，只能增加最后一个维度。例如，重拨保存(11，行)或甚至(11,0)都将失败。

#2

I stumbled across this question while hitting this road block myself. I ended up writing a piece of code real quick to handle this ReDim Preserve on a new sized array (first or last dimension). Maybe it will help others who face the same issue.

我在遇到这个问题的时候遇到了这个问题。最后，我编写了一段代码，非常快速地处理新大小的数组(第一或最后一个维度)上的重拨保存。也许它能帮助那些面临同样问题的人。

So for the usage, lets say you have your array originally set as MyArray(3,5), and you want to make the dimensions (first too!) larger, lets just say to MyArray(10,20). You would be used to doing something like this right?

因此，对于用法，假设您的数组最初被设置为MyArray(3,5)，并且您希望使维度(首先也是!)更大，我们只需对MyArray(10,20)说。你会习惯这样做，对吧?

 ReDim Preserve MyArray(10,20) '<-- Returns Error

But unfortunately that returns an error because you tried to change the size of the first dimension. So with my function, you would just do something like this instead:

但不幸的是，这将返回一个错误，因为您试图更改第一个维度的大小。对于我的函数，你可以这样做:

 MyArray = ReDimPreserve(MyArray,10,20)

Now the array is larger, and the data is preserved. Your ReDim Preserve for a Multi-Dimension array is complete. :)

现在，数组更大，数据被保存。多维数组的重拨保存完成。:)

And last but not least, the miraculous function: ReDimPreserve()

最后，不可思议的功能: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

I wrote this in like 20 minutes, so there's no guarantees. But if you would like to use or extend it, feel free. I would've thought that someone would've had some code like this up here already, well apparently not. So here ya go fellow gearheads.

我写了20分钟，所以没有保证。但如果你想使用或扩展它，请感到*。我本以为有人会有这样的代码，显然不是。这是你们这些家伙。

#3

I know this is a bit old but I think there might be a much simpler solution that requires no additional coding:

我知道这有点旧了，但我认为可能有一个更简单的解决方案，不需要额外的编码:

Instead of transposing, redimming and transposing again, and if we talk about a two dimensional array, why not just store the values transposed to begin with. In that case redim preserve actually increases the right (second) dimension from the start. Or in other words, to visualise it, why not store in two rows instead of two columns if only the nr of columns can be increased with redim preserve.

不要转置、重调和重调，如果我们讨论一个二维数组，为什么不首先存储转置的值呢?在这种情况下，redim preserve实际上从一开始就增加了右(第二个)维数。或者换句话说，为了直观地理解它，为什么不将两列存储在两行而不是两列中，只要列的nr可以通过redim preserve增加的话。

the indexes would than be 00-01, 01-11, 02-12, 03-13, 04-14, 05-15 ... 0 25-1 25 etcetera instead of 00-01, 10-11, 20-21, 30-31, 40-41 etcetera.

指数将会是00-01,01-11,02-12,03-13,04-14,05-15…0 25-1 25等等，而不是00-01 10-11 20-21 30-31 40-41等等。

As only the second (or last) dimension can be preserved while redimming, one could maybe argue that this is how arrays are supposed to be used to begin with. I have not seen this solution anywhere so maybe I'm overlooking something?

由于在重划时只能保留第二个(或最后一个)维，人们可能会认为这就是数组最初应该使用的方式。我在任何地方都没见过这个解所以我可能忽略了什么?

#4

here is updated code of the redim preseve method with variabel declaration, hope @Control Freak is fine with it:)

这里是reredim preseve方法的最新代码，带有variabel声明，希望@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