在 Excel VBA 中使用多维数组 ReDim Preserve

ReDim Preserve with multidimensional array in Excel VBA

提问by Derek

I can get this to work but am not sure if this is the correct or the most efficient way of doing this.

我可以让它工作，但不确定这是否是正确的或最有效的方法。

Details: Looping through 151 rows then assigning column Aand Bonly of those rows to a two dimensional array based on criteria in column C. With the criteria only 114 of the 151 rows are needed in the array.

详细信息：循环遍历 151 行，然后根据 column 中的条件将 columnA和B仅这些行分配给二维数组C。根据条件，数组中只需要 151 行中的 114 行。

I know that with ReDim Preserve you can only resize the last array dimension and you can't change the number of dimensions at all. So I have sized the rows in the array to be the total 151 rows using the LRowvariable but the actual rows I only need in the array is in variable ValidRowso it seems that (151-114) = 37 superfluous rows are in the array as a result of the ReDim Preserve line. I would like to make the array only as big as it needs to be which is 114 rows not 151 but not sure if this is possible see code below and any help much appreciated as I am new to arrays and have spent the best part of two days looking at this. Note: Columns are a constant no issue with them but rows vary.

我知道使用 ReDim Preserve 您只能调整最后一个数组维度的大小，而根本无法更改维度数。所以我使用LRow变量将数组中的行大小设置为总共 151 行，但我只需要在数组中的实际行是可变的，ValidRow所以似乎 (151-114) = 37 多余的行在数组中作为ReDim Preserve 线的结果。我想让数组只需要它的大小，即 114 行而不是 151 行，但不确定这是否可行，请参阅下面的代码，任何帮助都非常感谢，因为我是数组的新手并且已经度过了两个阶段中最好的部分天看着这个。注意：列是一个常数，它们没有问题，但行会有所不同。

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

采纳答案by Derek

Two more ways of doing this. FillArray4 - Initial array is created too large but second part of code moves this to a new array using a double loop which creates the array to be the exact size it needs to be.

还有两种方法可以做到这一点。FillArray4 - 创建的初始数组太大，但代码的第二部分使用双循环将其移动到新数组，该双循环将数组创建为所需的确切大小。

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 - Much simpler and my preferred optionas you only create one array. Initial loop determines the size the array needs to be and then second loop uses this to create array and store data. Note only two cols in both cases. Issue I had in this scenario was creating 2D array where rows varied. That's it for me time to go to the tropics for a well earned holiday!

Sub FillArray5 -因为您只创建一个数组，所以更简单，也是我的首选选项。初始循环确定数组需要的大小，然后第二个循环使用它来创建数组和存储数据。在这两种情况下只注意两个列。我在这种情况下遇到的问题是创建行不同的二维数组。这就是我去热带度过一个愉快的假期的时候了！

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

回答by Derek

I seemed to have got this to work by using transposition where the rows and cols are swapped around and still using ReDim Preserve then transposing at the end when assigning to a range. This way the array is exactly the size it needs to be with no blank cells.

我似乎已经通过使用换位来实现这一点，其中行和列被交换并仍然使用 ReDim Preserve 然后在分配给范围时在最后进行换位。这样，数组就正好是没有空白单元格所需的大小。

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

回答by Pieter Geerkens

Note also that the internal VBA implementation of REDIM is not guaranteeing to release the storage when it is sized down. It would be a common choice in such an implementation to not physically reduce the storage until the size dropped to less than half the input size.

另请注意，REDIM 的内部 VBA 实现不保证在缩小存储空间时释放存储空间。在这种实现中，在大小下降到小于输入大小的一半之前不物理减少存储将是一个常见的选择。

Have you considered creating a type-safe collection class to store this information instead of an array? In it's most basic form (for a storage type of Integer) it would look be a Class Module like this:

您是否考虑过创建一个类型安全的集合类来存储这些信息而不是数组？在最基本的形式中（对于整数的存储类型），它看起来是一个像这样的类模块：

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

A particular advantage of this implementation is that the sizing logic is completely removed from the client code, as it should be.

这种实现的一个特殊优点是大小逻辑完全从客户端代码中删除，正如它应该的那样。

Note that the Data type stored by such a patter can be any type supported by VBA, including an Array or another Class.

请注意，这种模式存储的数据类型可以是 VBA 支持的任何类型，包括数组或其他类。