22

Visual Basic 経由の Excel で、Excel に読み込まれた請求書の CSV ファイルを反復処理しています。請求書は、クライアントごとに決定可能なパターンになっています。

それらを動的な 2D 配列に読み込んでから、古い請求書を含む別のワークシートに書き込んでいます。配列の最後の次元のみが再調整される可能性があるため、行と列を逆にする必要があることを理解しており、マスターワークシートに書き込むときに転置します。

どこかで、構文が間違っています。私はすでに配列を次元化したと言っています。どういうわけか、静的配列として作成しましたか? 動的に動作させるには、何を修正する必要がありますか?

与えられた回答ごとの作業コード

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

9 に答える 9

48

これは正確には直感的ではありませんが、配列をディメンションで薄暗くした場合、配列をRedim (VB6 Ref)することはできません。リンクされたページからの正確な引用は次のとおりです。

ReDim ステートメントは、Private、Public、または Dim ステートメントを使用して空の括弧(次元の添字なし)で既に正式に宣言されている動的配列のサイズまたはサイズを変更するために使用されます。

つまり、代わりにdim invoices(10,0)

使用する必要があります

Dim invoices()
Redim invoices(10,0)

次に、ReDim を使用する必要があります。Redim Preserve (10,row)

警告: 多次元配列を再次元化する場合、値を保持したい場合は、最後の次元のみを増やすことができます。IERedim Preserve (11,row)または(11,0)失敗することさえあります。

于 2012-11-01T19:20:02.203 に答える
16

私はこの障害にぶつかりながら、この質問に出くわしました。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分くらいで書いたので保証はありません。ただし、使用したり拡張したりしたい場合は、お気軽に。誰かがこのようなコードをすでにここに持っていると思っていたでしょうが、明らかにそうではありません。それでは、仲間のギアヘッドに行きましょう。

于 2014-01-09T07:30:30.900 に答える
5

これは、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
于 2016-07-28T10:34:08.010 に答える