web-dev-qa-db-fra.com

ReDim Preserve avec tableau multidimensionnel dans Excel VBA

Je peux obtenir que cela fonctionne, mais je ne suis pas sûr que ce soit le moyen correct ou le plus efficace de le faire.

Détails: Parcourez 151 lignes, puis affectez les colonnes A et B uniquement à ces lignes dans un tableau à deux dimensions basé sur les critères de la colonne C. Avec les critères, seules 114 des 151 lignes sont nécessaires dans le tableau.

Je sais qu'avec ReDim Preserve, vous ne pouvez redimensionner que la dernière dimension d'un tableau et vous ne pouvez pas changer le nombre de dimensions. J'ai donc dimensionné les lignes du tableau de manière à obtenir le nombre total de 151 lignes à l'aide de la variable LRow, mais les lignes réelles dont j'ai seulement besoin dans le tableau sont dans la variable ValidRow. Il semble donc que (151-114) = 37 lignes superflues figurent dans le tableau. à la suite de la ligne ReDim Preserve. Je voudrais créer un tableau aussi grand que nécessaire, soit 114 lignes, pas 151, mais je ne suis pas sûr que cela soit possible. Voir le code ci-dessous et toute aide appréciée car je suis nouveau dans les tableaux et j'ai passé la plus grande partie de deux. jours à regarder cela. Remarque: les colonnes ne sont pas un problème constant, mais les lignes varient.

Sub FillArray2()

Dim Data() As Variant
Dim ValidRow, r, LRow As Integer

Sheets("Contract_BR_CONMaster").Select
LRow = Range("A1").End(xlDown).Row '151 total rows

Erase Data()

For r = 2 To LRow
 If Cells(r, 3).Value <> "Bridge From" And Cells(r, 3).Value <> "Bridge To" Then
  ValidRow = ValidRow + 1
  ReDim Preserve Data(1 To LRow, 1 To 2)
  Data(ValidRow, 1) = Range("A" & r).Value 'fills the array with col A
  Data(ValidRow, 2) = Range("B" & r).Value 'fills the array with col B
 End If

Next r

ActiveWorkbook.Worksheets("Test").Range("A2:B" & ValidRow + 1) = Data() 'assign after     loop has run through all data and assessed it

End Sub
arraysexcelvbamultidimensional-array
4
Derek

Deux autres façons de procéder. FillArray4 - Le tableau initial est créé trop volumineux, mais la deuxième partie du code le déplace dans un nouveau tableau à l'aide d'une boucle double qui crée le tableau à la taille exacte requise.

Sub FillArray4()

Dim Data() As Variant, Data2() As Variant
Dim ValidRow As Integer, r As Integer, lRow As Integer

Sheets("Contract_BR_CONMaster").Select
lRow = Range("A1").End(xlDown).Row '151 total rows

'Part I - array is bigger than it has to be
Erase Data()

For r = 2 To lRow
 If Cells(r, 3).Value <> "Bridge From" And Cells(r, 3).Value <> "Bridge To" Then
  ValidRow = ValidRow + 1 'this is the size the array needs to be 114 rows
  ReDim Preserve Data(1 To lRow, 1 To 2) 'but makes array to be 151 rows as based on lrow not ValidRow as cannot dynamically resize 1st dim of array when using preserve
  Data(ValidRow, 1) = Range("A" & r).Value 'fills the array with col A
  Data(ValidRow, 2) = Range("B" & r).Value 'fills the array with col B
 End If
Next r

'Part II
'move data from Data() array that is too big to new array Data2() that is perfectly sized as it uses ValidRow instead of lrow
Erase Data2()

For i = LBound(Data, 1) To UBound(Data, 1) 'Rows
For j = LBound(Data, 2) To UBound(Data, 2) 'Cols
 If Not IsEmpty(Data(i, j)) Then
  ReDim Preserve Data2(1 To ValidRow, 1 To 2)
  Data2(i, j) = Data(i, j) 'fills the new array with data from original array but only non blank dims; Data2(i,j) is not one particular row or col its an intersection in the array
  'as opposed to part one where you fill the initial array with data from cols A and B using seperate lines for each col
 End If

Next
Next
ActiveWorkbook.Worksheets("Test").Range("A2:B" & ValidRow + 1) = Data2() 'assign data from new array to worksheet

End Sub

Sub FillArray5 - Beaucoup plus simple et mon option préférée car vous ne créez qu'un seul tableau. La boucle initiale détermine la taille que doit avoir le tableau, puis la seconde boucle l’utilise pour créer un tableau et stocker des données. Notez seulement deux colonnes dans les deux cas. Le problème que j'avais dans ce scénario était la création d'un tableau 2D où les lignes variaient. Voilà pour moi le temps d'aller sous les tropiques pour des vacances bien méritées!

Sub FillArray5()

Dim Data() As Variant
Dim ValidRow As Integer, r As Integer, lRow As Integer, DimCount As Integer,  RemSpaceInArr As Integer

Sheets("Contract_BR_CONMaster").Select
lRow = Range("A1").End(xlDown).Row

Erase Data()

For r = 2 To lRow
 If Cells(r, 3).Value <> "Bridge From" And Cells(r, 3).Value <> "Bridge To" Then
  ValidRow = ValidRow + 1 'this is the size the array needs to be 114 rows
 End If
Next r

DimCount = 0 'reset
 For r = 2 To lRow
  If Cells(r, 3).Value <> "Bridge From" And Cells(r, 3).Value <> "Bridge To" Then
   ReDim Preserve Data(1 To ValidRow, 1 To 2) 'makes array exact size 114 rows using ValidRow from first loop above
   DimCount = DimCount + 1 'need this otherwise ValidRow starts the dim at 114 but needs to start at 1 and increment to max of ValidRow
   Data(DimCount, 1) = Range("A" & r).Value 'fills the array with col A
   Data(DimCount, 2) = Range("B" & r).Value 'fills the array with col B
  End If
 Next r
 RemSpaceInArr = ValidRow - DimCount 'just a check it should be 0

ActiveWorkbook.Worksheets("Test").Range("A2:B" & ValidRow + 1) = Data() 'assign data from array to worksheet

End Sub
1
Derek

Cela semblait fonctionner en utilisant une transposition où les lignes et les colonnes sont permutées et en utilisant ReDim Preserve, puis en transposant à la fin lors de l'attribution d'une plage. De cette façon, le tableau a exactement la taille requise, sans cellules vides.

Sub FillArray3() 'Option 3 works using transposition where row and cols are swapped then swapped back at the end upon assignment to the range with no blank cells as array is sized incrementally via the For/Next loop

Dim Data() As Variant
Dim ValidRow, r, LRow As Integer

Sheets("Contract_BR_CONMaster").Select
LRow = Range("A1").End(xlDown).Row '151 total rows

Erase Data()

For r = 2 To LRow
 If Cells(r, 3).Value <> "Bridge From" And Cells(r, 3).Value <> "Bridge To" Then
  ValidRow = ValidRow + 1
  ReDim Preserve Data(1 To 2, 1 To ValidRow) 'can change the size of only the last dimension if you use Preserve so swapped rows and cols around
  Data(1, ValidRow) = Range("A" & r).Value 'fills the array with col A
  Data(2, ValidRow) = Range("B" & r).Value 'fills the array with col B
 End If

Next r

ActiveWorkbook.Worksheets("Test").Range("A2:B" & ValidRow + 1) = Application.Transpose(Data) 'swap rows and cols back

End Sub
4
Derek

Notez également que l'implémentation VBA interne de REDIM ne garantit pas la libération du stockage lorsqu'il est dimensionné. Dans une telle implémentation, il serait courant de ne pas réduire physiquement le stockage tant que la taille ne sera pas réduite à moins de la moitié de la taille d'entrée.

Avez-vous envisagé de créer une classe de collection sécurisée pour stocker ces informations au lieu d'un tableau? Dans sa forme la plus élémentaire (pour un type de stockage de type Integer), il s’agirait d’un module de classe semblable à celui-ci:

Option Explicit

Private mData As Collection

Public Sub Add(Key As String, Data As Integer)
    mData.Add Key, Data
End Sub

Public Property Get Count() As Integer
    Count = mData.Count
End Property

Public Function Item(Index As Variant) As Integer
    Item = mData.Item(Index)
End Function

Public Sub Remove(Item As Integer)
    mData.Remove Item
End Sub


Private Sub Class_Initialize()
    Set mData = New Collection
End Sub

Un avantage particulier de cette implémentation réside dans le fait que la logique de dimensionnement est complètement supprimée du code client, comme il se doit.

Notez que le type de données stocké par un tel modèle peut être n'importe quel type pris en charge par VBA, y compris un tableau ou une autre classe. 

2
Pieter Geerkens