VBA如何运行代码，直到它到达最后一个max函数

Question

我有一个数组代码，可以保存我的电子表格中D +到D列的所有数据，但是它也保存了我不想要的工作表中的所有空白单元格。 所有列都有相同的行数，但理想情况下我希望数组从第二行开始，直到找到它从列D开始的最后一次重复。我的代码是：

Sub PopulatingArrayVariable()

Dim myArray() As Variant
Dim DataRange As Range
Dim cell As Range
Dim x As Long
Dim TotalTargets As Double

TotalTargets = WorksheetFunction.Max(Columns("D"))

Set DataRange = Sheets("Result").Range("D:I")

For Each cell In DataRange.Cells
    ReDim Preserve myArray(x)
    myArray(x) = cell.Value
    x = x + 1
Next cell
End Sub

Answer 1

这是一种替代方法，应该完全跳过ReDim Preserve 。

看看它是否有助于你的情况。

Sub BuildArray()
Dim lngLastRow As Long
Dim rng As Range
Dim arList As Object
Dim varOut As Variant

lngLastRow = Sheets("Result").Range("D:I").Find("*", Sheets("Result").Range("D1"), , , xlByRows, xlPrevious).Row
Set arList = CreateObject("System.Collections.ArrayList")
For Each rng In Sheets("Result").Range("D1:I" & lngLastRow)
    If Len(Trim(rng.Value)) > 0 Then
        arList.Add rng.Value
    End If
Next
varOut = arList.ToArray

End Sub

Answer 2

在添加到数组之前添加单元格长度的条件：

For Each cell In DataRange.Cells
    If Len(Trim(Cells)) > 0 Then
        ReDim Preserve myArray(x)
        myArray(x) = cell.Value
        x = x + 1
    End If
Next cell

Trim()将从左侧和右侧移除空格，因此如果只有一个像这样的空间的单元格 它仍然会给0并且不会被考虑在内。

修剪MSDN