Excel VBA中多维数组的ReDim保存

cpjpxq1n  于 2023-03-20  发布在  其他
关注(0)|答案(4)|浏览(283)

我可以让这个工作,但不确定这是否是正确的或最有效的方式这样做。
详细信息:循环151行,然后根据列C中的条件,仅将这些行中的列AB分配给二维数组。使用该条件,数组中仅需要151行中的114行。
我知道,使用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
new9mtju

new9mtju1#

我似乎已经得到了这个工作,通过使用转置,其中行和列交换左右,仍然使用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
35g0bw71

35g0bw712#

另请注意,REDIM的内部VBA实现并不保证在减小存储大小时释放存储。在这种实现中,通常的选择是在存储大小减小到输入大小的一半以下之前不物理地减小存储。
你有没有考虑过创建一个类型安全的集合类来代替数组来存储这些信息?在它最基本的形式中(对于存储类型为Integer),它看起来像是一个类模块:

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或其他Class。

xriantvc

xriantvc3#

还有两种方法。FillArray 4-创建的初始数组太大,但代码的第二部分使用双循环将其移动到一个新数组,该双循环将数组创建为所需的确切大小。

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 FillArray 5-简单多了,我的首选因为你只创建一个数组。初始循环决定数组需要的大小,然后第二个循环使用它来创建数组和存储数据。注意在两种情况下只有两个列。我在这个场景中遇到的问题是创建行不同的二维数组。这是我去热带度假的时间!

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
mlnl4t2r

mlnl4t2r4#

在我的例子中,我将usedrange转换为变量数组以提高速度(VBA中的复杂计算)。没有(简单)的方法。因此,如果我事先知道,我可能最多添加多少行,我只是将预期的行数添加到初始范围进行传输。下面我们开始:

Sub Add_max_50_Rows_via_variant_array()
Dim Ca As Variant
Dim Ra As Range
'assume I wish to add max. 50 columns
Set Ra = ActiveSheet.Range([a1], Cells(ActiveSheet.UsedRange.Rows.Count + 50, ActiveSheet.UsedRange.Columns.Count))
Ca = Ra
'in the example: Assume the initial sheet has 8 rows:
Debug.Print Ca(8, 4) 'example
Ca(9, 1) = 991 'the ninth row is available in the array
Ra = Ca 'and will be reported back to the initial range, of course.
Debug.Print ActiveSheet.UsedRange.Rows.Count '9 - Usedrange is extended to 
    '9 rows only, which is ok.

末端子组件

相关问题