web-dev-qa-db-fra.com

Excel VBA - Comment redimensionner un tableau 2D?

Dans Excel via Visual Basic, je parcours un fichier CSV de factures chargé dans Excel. Les factures sont configurables par client.

Je les lis dans un tableau 2D dynamique, puis je les écris dans une autre feuille de calcul avec des factures plus anciennes. Je comprends que je dois inverser les lignes et les colonnes car seule la dernière dimension d’un tableau peut être Redimmed, puis transposée lorsque je l’écris dans la feuille de calcul principale.

Quelque part, j'ai la syntaxe fausse. Il n'arrête pas de me dire que j'ai déjà dimensionnalisé le tableau. D'une façon ou d'une autre l'ai-je créé comme tableau statique? Que dois-je réparer pour le laisser fonctionner de manière dynamique?

CODE DE TRAVAIL PAR REPONSE 

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

Ce n'est pas tout à fait intuitif, mais vous ne pouvez pas Redim (VB6 Ref) un tableau si vous l'avez grisé avec des dimensions. La citation exacte de la page liée est: 

L'instruction ReDim est utilisée pour dimensionner ou redimensionner un tableau dynamique comportant déjà été officiellement déclaré en utilisant un fichier privé, public ou dim instruction avec parenthèses vides (sans indices de dimension).

En d'autres termes, au lieu de dim invoices(10,0)

Tu devrais utiliser 

Dim invoices()
Redim invoices(10,0)

Ensuite, lorsque vous utilisez ReDim, vous devrez utiliser Redim Preserve (10,row)

Avertissement: lorsque vous redimensionnez des tableaux multidimensionnels, si vous souhaitez conserver vos valeurs, vous ne pouvez augmenter que la dernière dimension. C'EST À DIRE. Redim Preserve (11,row) ou même (11,0) échouerait.

34
Daniel

Je suis tombé sur cette question tout en heurtant moi-même cet obstacle. J'ai fini par écrire un morceau de code vraiment rapide pour gérer ce ReDim Preserve sur un nouveau tableau de taille (première ou dernière dimension). Peut-être que cela aidera d'autres personnes confrontées au même problème.

Donc, pour l’utilisation, disons que vous avez initialement défini votre tableau sur MyArray(3,5) et que vous voulez agrandir les dimensions (d’abord aussi!), Disons simplement MyArray(10,20). Vous seriez habitué à faire quelque chose comme ça, non?

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

Mais malheureusement, cela renvoie une erreur car vous avez essayé de modifier la taille de la première dimension. Donc, avec ma fonction, vous feriez simplement quelque chose comme ceci:

 MyArray = ReDimPreserve(MyArray,10,20)

Maintenant, le tableau est plus grand et les données sont préservées. Votre ReDim Preserve pour un tableau Multi-Dimension est terminé. :)

Et le dernier mais non le moindre, la fonction miraculeuse: 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

J'ai écrit ça en 20 minutes, donc il n'y a aucune garantie. Mais si vous souhaitez l'utiliser ou l'étendre, n'hésitez pas. J'aurais pensé que quelqu'un aurait déjà eu un code comme celui-là, apparemment pas. Alors voilà, les autres engrenages.

11
Control Freak

Je sais que c'est un peu vieux mais je pense qu'il pourrait y avoir une solution beaucoup plus simple qui ne nécessite aucun codage supplémentaire:

Au lieu de transposer, redimensionner et transposer à nouveau, et si nous parlons d'un tableau à deux dimensions, pourquoi ne pas simplement stocker les valeurs transposées pour commencer. Dans ce cas, redim conserve augmente la bonne (deuxième) dimension dès le départ. Ou, en d'autres termes, pour le visualiser, pourquoi ne pas stocker dans deux lignes au lieu de deux colonnes si seul le nombre de colonnes peut être augmenté avec redim préserv.

les indices seraient alors 00-01, 01-11, 02-12, 03-13, 04-14, 05-15 ... 0 25-1 25 etc. au lieu de 00-01, 10-11, 20-21 , 30-31, 40-41 etc.

Etant donné que seule la deuxième (ou dernière) dimension peut être préservée lors du redimming, on pourrait peut-être soutenir que c’est ainsi que les tableaux sont censés être utilisés pour commencer. ?

4
hombibi

voici le code mis à jour de la méthode redim preserve avec la déclaration variabel, espérons que @Control Freak va très bien :)

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

Voici comment je fais cela.

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

j'ai résolu ceci d'une manière plus courte.

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