web-dev-qa-db-de.com

Excel VBA - Wie kann ich ein 2D-Array neu gestalten?

In Excel über Visual Basic durchlaufe ich eine CSV-Datei mit Rechnungen, die in Excel geladen wird. Die Rechnungen sind vom Kunden in einem bestimmbaren Muster festgelegt.

Ich lese sie in ein dynamisches 2D-Array und schreibe sie dann mit älteren Rechnungen in ein anderes Arbeitsblatt. Ich verstehe, dass ich Zeilen und Spalten umkehren muss, da möglicherweise nur die letzte Dimension eines Arrays angepasst wird und dann transponiert wird, wenn ich es in das Master-Arbeitsblatt schreibe.

Irgendwo habe ich die Syntax falsch. Es sagt mir immer wieder, dass ich das Array bereits dimensioniert habe. Habe ich es irgendwie als statisches Array erstellt? Was muss ich beheben, damit es dynamisch arbeiten kann?

ARBEITSCODE PRO ANTWORTEN

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
17
Liquidgenius

Das ist zwar nicht gerade intuitiv, aber Sie können kein Array redim (VB6 Ref) Array erstellen, wenn Sie es mit Bemaßungen abgeblendet haben. Das genaue Angebot von der verlinkten Seite lautet: 

Die ReDim-Anweisung wird verwendet, um die Größe eines dynamischen Arrays mit .__ zu ändern. wurde bereits formal mit einem privaten, öffentlichen oder Dim .__ deklariert. Anweisung mit leeren Klammern (ohne Dimensionsskripte).

Mit anderen Worten, anstelle von dim invoices(10,0)

Du solltest benutzen 

Dim invoices()
Redim invoices(10,0)

Wenn Sie ReDim verwenden, müssen Sie Redim Preserve (10,row) verwenden.

Warnung: Wenn Sie mehrdimensionale Arrays neu dimensionieren und Ihre Werte beibehalten möchten, können Sie nur die letzte Dimension vergrößern. I.E. Redim Preserve (11,row) oder sogar (11,0) würde fehlschlagen.

34
Daniel

Ich bin über diese Frage gestolpert, als ich selbst diese Straßensperre traf. Am Ende habe ich einen Code geschrieben, um diesen ReDim Preserve in einem Array mit neuer Größe (erste oder letzte Dimension) schnell zu verarbeiten. Vielleicht hilft es anderen, die das gleiche Problem haben.

Nehmen wir für die Verwendung an, Sie haben Ihr Array ursprünglich als MyArray(3,5) festgelegt, und Sie möchten die Abmessungen (zuerst auch!) Größer machen, sagen wir einfach MyArray(10,20). Sie wären es gewohnt, so etwas richtig zu machen?

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

Dies gibt jedoch leider einen Fehler zurück, da Sie versucht haben, die Größe der ersten Dimension zu ändern. Mit meiner Funktion würden Sie stattdessen einfach so etwas tun:

 MyArray = ReDimPreserve(MyArray,10,20)

Jetzt ist das Array größer und die Daten bleiben erhalten. Ihr ReDim Preserve für ein Multi-Dimension-Array ist abgeschlossen. :)

Und nicht zuletzt die wundersame Funktion: 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

Ich habe das in etwa 20 Minuten geschrieben, daher gibt es keine Garantien. Wenn Sie es jedoch verwenden oder erweitern möchten, fühlen Sie sich frei. Ich hätte gedacht, dass jemand hier oben schon so etwas Code hatte, naja anscheinend nicht. Also los gehts mit den anderen Getrieben.

11
Control Freak

Ich weiß, dass dies ein bisschen alt ist, aber ich denke, dass es eine viel einfachere Lösung gibt, die keine zusätzliche Codierung erfordert:

Anstatt erneut zu transponieren, rotieren und transponieren, und wenn wir über ein zweidimensionales Array sprechen, warum sollten Sie nicht einfach die Werte speichern, die zuerst transponiert wurden. In diesem Fall vergrößert redim preserve tatsächlich die rechte (zweite) Dimension von Anfang an. Oder, um es zu visualisieren, warum nicht in zwei Reihen statt in zwei Spalten speichern, wenn nur die Anzahl der Spalten mit redim preserve erhöht werden kann.

die Indizes wären dann 00-01, 01-11, 02-12, 03-13, 04-14, 05-15 ... 0 25-1 25 usw. anstelle von 00-01, 10-11, 20-21 30-31, 40-41 usw.

Da beim Redimming nur die zweite (oder letzte) Dimension erhalten werden kann, könnte man vielleicht argumentieren, dass Arrays so verwendet werden sollten, um mit ... zu beginnen ?

4
hombibi

hier ist aktualisierter Code der redim preserve-Methode mit variabel-Deklaration, hoffe @Control Freak ist damit einverstanden :)

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

Ein kleines Update zu dem, was @control freak und @skatun zuvor geschrieben haben (sorry, ich habe nicht genug Reputation, um nur einen Kommentar abzugeben). Ich habe den Code von skatun verwendet und es hat gut funktioniert, außer dass ein größeres Array erstellt wurde, als ich brauchte. Deshalb habe ich geändert:

ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound)

zu:

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

Dies behält für beide Dimensionen bei, was auch immer die unteren Grenzen des ursprünglichen Arrays waren (entweder 0, 1 oder was auch immer; der ursprüngliche Code nimmt 0 an).

1
TaitK

So mache ich das.

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

ich habe das kürzer gelöst.

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