Excel VBA - jak zmniejszyć liczbę macierzy 2D?

Question

W programie Excel za pośrednictwem Visual Basic, I iterating poprzez plik CSV faktur, które jest ładowany do programu Excel. Faktury są w zadeklarowanym wzorcu według klienta.

Czytam je do dynamicznej tablicy 2D, a następnie zapisuję je w innym arkuszu roboczym ze starszymi fakturami. Rozumiem, że muszę odwrócić wiersze i kolumny, ponieważ tylko ostatni wymiar tablicy może być przekreślony, a następnie przetransponowany, gdy zapisuję go w głównym arkuszu.

Gdzieś, mam błędną składnię. Powtarza mi się, że już zmaterializowałem tablicę. W jakiś sposób utworzyłem go jako statyczną tablicę? Co muszę naprawić, aby działało dynamicznie?

KODEKS PRACY ZA Odpowiedź udzielona

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

To nie jest dokładnie to, intuicyjny, ale nie można Redim (VB6 Ref) tablicą jeśli przyciemnione jej wymiarach. Dokładny cytat z połączonej stronie:

Oświadczenie ReDim służy do wielkości lub rozmiaru tablicy dynamicznej, który już oficjalnie zadeklarowana przy użyciu prywatnego, publicznego lub Dim oświadczenie z pustych nawiasów (bez wymiaru indeksy dolne).

Innymi słowy, zamiast dim invoices(10,0)

Należy użyć

Dim invoices() 
Redim invoices(10,0) 

Wtedy, kiedy ReDim, trzeba użyć Redim Preserve (10,row)

Ostrzeżenie: Redimensioning wielowymiarowe tablice, jeśli chcesz zachować swoje wartości, możesz tylko zwiększyć ostatni wymiar. TO ZNACZY. Redim Preserve (11,row) lub nawet (11,0) może zawieść.

Answer 2

Natknąłem się na to pytanie, uderzając jednocześnie w tę blokadę. Skończyło się na tym, że napisałem kawałek kodu naprawdę szybko, aby obsłużyć to ReDim Preserve w nowej tablicy (pierwszy lub ostatni wymiar). Może to pomoże innym, którzy staną w obliczu tego samego problemu.

Jeśli chodzi o użycie, powiedzmy, że macie pierwotnie ustawioną tablicę jako MyArray(3,5), a także chcecie, aby wymiary (również!) Były większe, powiedzmy po prostu MyArray(10,20). Byłbyś przyzwyczajony do robienia czegoś takiego, prawda?

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

Niestety, ten błąd zwraca błąd, ponieważ próbowano zmienić rozmiar pierwszego wymiaru. Tak więc z moją funkcją po prostu zrobiłbyś coś takiego:

MyArray = ReDimPreserve(MyArray,10,20) 

Teraz tablica jest większa, a dane są zachowane. Twoja ReDim Preserve dla tablicy wielowymiarowej została zakończona.:)

I last but not least, cudowna funkcja: 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 

pisałem o tym jak 20 minut, więc nie ma gwarancji. Ale jeśli chcesz go użyć lub rozszerzyć, poczuj się swobodnie. Pomyślałbym, że ktoś już wcześniej miałby taki kod, najwyraźniej nie. Więc idźcie razem z innymi motoreduktorami.

Answer 3

tutaj jest aktualizowana kod metody ReDim preseve z deklaracją Variabel, nadzieję @Control Freak jest w porządku z nim :)

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 

Answer 4

wiem, że to jest nieco stary, ale myślę, że może być znacznie prostsze rozwiązanie, które nie wymaga dodatkowego kodowania:

Zamiast ponownie transponować, ponownie przyciemniać i transponować, a jeśli mówimy o tablicy dwuwymiarowej, to dlaczego nie przechowywać po prostu wartości przeniesionych na początek. W takim przypadku zachowanie redim faktycznie zwiększa właściwy (drugi) wymiar od początku. Innymi słowy, aby go zwizualizować, nie przechowuj go w dwóch wierszach zamiast dwóch kolumnach, jeśli tylko liczba kolumn może zostać zwiększona z zachowaniem redim.

indeksy byłyby niż być 00-01, 01-11, 02-12, 13/03, 14/04, 15/05 ... 0 25-1 25 etcetera zamiast 00-01, 10-11 , 20-21, 30-31, 40-41 itd.

Jak tylko drugi (lub ostatni) wymiar może być zachowana podczas redimming, można by argumentować, że może to jest jak tablice mają być stosowane na początku. Nie widziałem tego rozwiązania w dowolnym miejscu, więc może coś przeoczyłem?