ReDim在Excel VBA中用multidimensional array保存

我可以得到这个工作，但不知道这是否是正确的或最有效的方式做到这一点。

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

我知道，使用ReDim Preserve，您只能调整最后一个数组维度，并且不能更改维数。 所以我已经使用LRowvariables调整了数组中的行的总数为151行，但是我只需要在数组中的实际行数在variablesValidRow所以看起来（151-114）= 37多余的行在数组中作为ReDim保留线的结果。 我想使arrays只有它所需要的那么大，这是114行不是151，但不知道这是可能的，看下面的代码和任何帮助非常赞赏，因为我是新的arrays，花了两个最好的部分天看着这个。 注意：列是一个常量没有问题，但行不同。

 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保留，然后在分配到一个范围末尾转置。 这样数组就是没有空白单元格的大小。

 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实现并不能保证在缩小尺寸时释放存储空间。 在这样的实现中，在物理尺寸下降到小于input尺寸的一半之前，物理上不会减less存储量是常见的select。

你有没有考虑创build一个types安全的集合类来存储这个信息，而不是一个数组？ 这是最基本的forms（对于Integer存储types），它看起来像这样的一个类模块：

 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 

这种实现的一个特别的优点是，大小调整逻辑完全从客户端代码中删除，因为它应该是。

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

Answer 3

还有两种方法可以做到这一点。 FillArray4 – 初始数组被创build得太大，但是代码的第二部分使用双循环将其移动到一个新的数组中，这个循环创build的数组就是它所需要的确切大小。

 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 

子FillArray5 – 更简单和我首选的选项，因为你只创build一个数组。 初始循环决定数组的大小，然后第二个循环使用它来创build数组和存储数据。 在这两种情况下只注意两个cols。 我在这种情况下的问题是创build二维数组的行不同。 那就是我该去热带度假的好地方了！

 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