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

时间:2018-02-07 11:05:21

标签: arrays excel vba excel-vba max

我有一个数组代码,用于保存电子表格中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

2 个答案:

答案 0 :(得分:2)

这是一种替代方法,应该完全跳过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

答案 1 :(得分:1)

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

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并且不会被考虑在内。

Trim MSDN