Excel VBA - 如何重新调整二维数组？

Excel VBA - How to Redim a 2D array?

提问by Liquidgenius

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 中，我正在遍历加载到 Excel 中的发票的 CSV 文件。发票采用客户可确定的模式。

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.

我正在将它们读入动态二维数组，然后将它们写入另一个带有旧发票的工作表。我知道我必须反转行和列，因为只有数组的最后一个维度可能是 Redimmed，然后在我将它写入主工作表时转置。

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 
Dim invoices()
Redim invoices(10,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

回答by Daniel

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 语句用于调整已使用 Private、Public 或 Dim 语句和空括号（无维度下标）正式声明的动态数组的大小或调整大小。

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

换句话说，而不是 dim invoices(10,0)

You should use

你应该使用

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

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

然后当你 ReDim 时，你需要使用 Redim Preserve (10,row)

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.

警告：重新维度多维数组时，如果你想保留你的值，你只能增加最后一个维度。IERedim Preserve (11,row)甚至(11,0)会失败。

回答by Control Freak

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 Preserveon a new sized array (first or last dimension). Maybe it will help others who face the same issue.

我在自己遇到这个障碍时偶然发现了这个问题。我最终编写了一段代码来快速处理ReDim Preserve一个新大小的数组（第一维或最后一维）。也许它会帮助面临同样问题的其他人。

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)，并且您想让维度（首先也是！）更大，让我们说 to MyArray(10,20)。你会习惯做这样的事情吗？

 MyArray = ReDimPreserve(MyArray,10,20)

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:

但不幸的是，这会返回错误，因为您试图更改第一维的大小。因此，使用我的函数，您只需执行以下操作：

'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

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

现在数组更大了，数据被保留了下来。您ReDim Preserve的多维数组已完成。:)

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

最后但并非最不重要的是，神奇的功能： ReDimPreserve()

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

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 分钟内写了这篇文章，所以不能保证。但是，如果您想使用或扩展它，请随意。我本以为有人已经在这里有了一些这样的代码，显然不是。所以这里是你们的齿轮头。

回答by hombibi

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?

由于在重新调光时只能保留第二个（或最后一个）维度，因此人们可能会争辩说这就是数组应该被使用的方式。我没有在任何地方看到过这个解决方案，所以也许我忽略了一些东西？

回答by skatun

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

这是带有变量声明的 redim preseve 方法的更新代码，希望@Control Freak 可以接受它:)

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

回答by Reanoe

Here is how I do this.

这是我如何做到这一点。

ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound)

回答by TaitK

A small update to what @control freak and @skatun wrote previously (sorry I don't have enough reputation to just make a comment). I used skatun's code and it worked well for me except that it was creating a larger array than what I needed. Therefore, I changed:

对@control freak 和@skatun 之前写的内容的一个小更新（对不起，我没有足够的声誉来发表评论）。我使用了 skatun 的代码，它对我来说效果很好，只是它创建了一个比我需要的更大的数组。因此，我改变了：

ReDim aPreservedArray(LBound(aArrayToPreserve, 1) To nNewFirstUBound, LBound(aArrayToPreserve, 2) To nNewLastUBound)

to:

到：

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

This will maintain whatever the original array's lower bounds were (either 0, 1, or whatever; the original code assumes 0) for both dimensions.

这将保持两个维度的原始数组的下限（0、1 或其他；原始代码假定为 0）。

回答by Tony Raymond

Here ya go.

给你。

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

回答by Federico Montenegro

You could do this array(0)= array(0,1,2,3).

你可以这样做array(0)= array(0,1,2,3)。

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

回答by Diggity

i solved this in a shorter fashion.

我以更短的方式解决了这个问题。

##代码##