Excel VBA - 如何重命名2D数组？

Question

在Excel中通过Visual Basic,我正在迭代加载到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.

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

Answer 1

这不是很直观,但如果你用尺寸调暗它,你就不能使用Redim (VB6 Ref)数组.链接页面的确切报价是:

ReDim语句用于调整或调整已使用带有空括号(没有维度下标)的Private,Public或Dim语句正式声明的动态数组.

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

你应该用

Dim invoices()
Redim invoices(10,0)

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

警告:在重新定义多维数组时,如果要保留值,则只能增加最后一个维.IE Redim Preserve (11,row)甚至(11,0)会失败.

Answer 2

我在遇到这个障碍时偶然发现了这个问题.我最终编写了一段代码,以便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分钟,所以没有保证.但如果您想使用或扩展它,请随意.我会认为有人会在这里有一些像这样的代码,显然不是.所以在这里,你去了同样的齿轮箱.

Answer 3

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

如果我们谈论二维数组，为什么不直接存储转置后的值，而不是再次转置、重新调暗和转置。在这种情况下，redimserve 实际上从一开始就增加了正确的（第二个）维度。或者换句话说，为了可视化它，如果只能通过 redimserve 增加列数，为什么不存储在两行而不是两列中。

索引将是 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 等等。

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

Answer 4

这里是带有变量声明的 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