web-dev-qa-db-ja.com

Excel VBA-2D配列を再適用する方法

Visual Basic経由のExcelでは、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
arraysexcelvbaexcel-vbamultidimensional-array
17
Liquidgenius

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

ReDimステートメントは、emptyかっこ（なしディメンションの添え字）。

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

あなたが使用する必要があります

_Dim invoices()
Redim invoices(10,0)
_

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

警告：多次元配列を再次元化するときに、値を保持したい場合は、最後の次元のみを増やすことができます。 I.E. Redim Preserve (11,row)または_(11,0)_でも失敗します。

36
Daniel

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

12
Control Freak

私はこれが少し古いことを知っていますが、追加のコーディングを必要としないはるかに簡単なソリューションがあるかもしれないと思います：

転置、再配置、再転置の代わりに、2次元配列について説明する場合は、最初に転置された値だけを保存してください。その場合、redim preserveは実際には最初から右（2番目）の次元を増やします。または、言い換えれば、それを視覚化するために、列のnrのみをredim preserveで増やすことができる場合は、2列ではなく2行で保存してください。

インデックスは00-01、10-11、20-21ではなく00-01、01-11、02-12、03-13、04-14、05-15 ... 0 25-1 25などです、30-31、40-41など。

2番目の（または最後の）次元のみがリダイム中に保持できるため、これが配列の使用方法を最初から想定していると主張することができます。私はどこでもこの解決策を見たことがないので、何かを見落としているかもしれませんか？

4
hombibi

ここに、variabel宣言を含むredim preserveメソッドの更新されたコードがあります。@ 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
3
skatun

@control freakと@skatunが以前に書いたものの小さな更新です（ごめんなさい、コメントするだけの評判はありません）。 skatunのコードを使用しましたが、うまく機能しましたが、必要なものよりも大きな配列を作成していました。したがって、私は変更しました：

ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound)

に：

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

これにより、元の配列の下限が何であれ（0、1、または何でも。元のコードは0と想定）、両方の次元で維持されます。

1
TaitK

これが私がこれを行う方法です。

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
1
Reanoe

これを短い方法で解決しました。

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
0
Diggity