ReDim在Excel VBA中使用多维数组保留

Question

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

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

我知道使用ReDim Preserve，您只能调整最后一个数组维度，并且根本无法更改维度数。所以我使用LRow变量将数组中的行调整为总共151行，但是我在数组中只需要的实际行是变量ValidRow所以看起来（151-114）由于ReDim Preserve线，数组中有37个多余的行。我想使数组只有它需要的大到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

Answer 1

我似乎通过使用换位来实现这一点，其中行和列交换并且仍然使用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

Answer 2

另请注意，REDIM的内部VBA实现并不保证在大小缩小时释放存储。在这种实现中，在物理尺寸降至输入尺寸的一半以下之前，不会物理地减少存储量是一种常见的选择。

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

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

此实现的一个特殊优势是，调整逻辑完全从客户端代码中删除，应该是这样。

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

Answer 3

另外两种方法。 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 - 更简单，我的首选选项，因为您只创建一个数组。初始循环确定数组需要的大小，然后第二个循环使用它来创建数组和存储数据。在这两种情况下只注意两个cols。我在这种情况下遇到的问题是创建行数变化的二维数组。那是我花时间去热带度假的好时光！

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