创建行数组VBA答案

【问题标题】：Create an array of rows VBA创建行数组VBA
【发布时间】：2018-08-14 17:56:59
【问题描述】：

VBA 新手。我正在尝试创建一个行数组。

基本上，我有一整张工作表，并且想要在第 8 列中获取以某个值（“MA”）开头的所有行。

我最终想要操作该数组（就好像它是一个范围一样），并将其粘贴到工作表的其他位置。任何人都可以帮忙吗？到目前为止，这是我的代码：

Dim top0M As Variant
ReDim top0M(1 To 1) As Variant

For i = 4 To Rows.Count
    If Cells(i, 8).Value Like "MA*" Then
        top0M(UBound(top0M)) = Rows(i)
        ReDim Preserve top0M(1 To UBound(top0M) + 1) As Variant
    End If
Next i

此代码运行，但我不确定如何调试它以了解我是否有正确的行。我可以像粘贴范围一样粘贴这些行吗？

【问题讨论】：

您正在创建一个数组数组，因此要保存到另一个工作表，您需要循环并将每个数组分配给目标工作表中的下一个开放行。
要构建一个范围数组，您需要将Dim top0M As Variant 和ReDim top0M(1 To 1) As Variant 更改为Dim top0M As Range 和ReDim top0M(1 To 1) As Range，尽管您实际上只需要一个Dim top0M(1 To 1) As Range
有没有可以用来限制列范围的行？您正在循环整个工作表 1048576 行并获取所有列最多的部分，这些列将是空白的，我们应该忽略。
@Kyle 它不适用于 Range，一直在其他地方给我“预期数组”
@ScottCraner 谢谢，我将其替换为 UsedRange.Rows.Count。难怪这么慢！

标签： arrays vba excel

【解决方案1】：

这会设置范围并将整个加载到一个数组中，然后它会加载一个包含您想要的行的不同数组：

With ActiveSheet 'This should be changed to the name of the worksheet: Worksheets("MySheet")
    Dim rng As Range
    Set rng = .Range(.Cells(4, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(4, .Columns.Count).End(xlToLeft).Column))


    Dim tot As Variant
    tot = rng.Value

    Dim top0M As Variant
    ReDim top0M(1 To Application.CountIf(.Range("H:H"), "MA*"), 1 To UBound(tot, 2)) As Variant
    Dim k As Long
    k = 1
    Dim i As Long
    For i = LBound(tot, 1) To UBound(tot, 1)
        If tot(i, 8) Like "MA*" Then
            Dim j As Long
            For j = LBound(tot, 2) To UBound(tot, 2)
                top0M(k, j) = tot(i, j)
            Next j
            k = k + 1
        End If
    Next i
End With

'to print to a sheet just assign the values:

Worksheets("sheet1").Range("A1").Resize(UBound(top0M, 1), UBound(top0M, 2)).Value = top0M

【讨论】：

我在以下行收到“需要对象”运行时异常：Set rng = .Range(ActiveSheet.Cells(4, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(4, .Columns.Count).End(xlToLeft).Column)).Value
@Tiberiu 我希望您的旧代码的速度会显着提高。

【解决方案2】：

试试这个代码

Sub Test()
Dim x           As Variant

x = ActiveSheet.Range("A4").CurrentRegion.Value
x = FilterArray(x, 8, "MA*", True)

ActiveSheet.Range("K14").Resize(UBound(x, 1), UBound(x, 2)).Value = x
End Sub

Function FilterArray(ByVal myRefArr As Variant, ByVal col As Integer, ByVal refValue As String, ByVal equal As Boolean) As Variant
Dim a           As Variant
Dim i           As Long
Dim j           As Long
Dim n           As Long

On Error Resume Next
    n = 1

    If refValue = "" Then
        FilterArray = myRefArr
    Else
        ReDim a(1 To UBound(myRefArr, 1), 1 To UBound(myRefArr, 2))
        For i = 1 To UBound(a, 1)
            If IIf(equal, UCase(myRefArr(i, col)) Like UCase(refValue), Not (UCase(myRefArr(i, col)) Like UCase(refValue))) Then
                For j = 1 To UBound(a, 2)
                    a(n, j) = myRefArr(i, j)
                Next j
                n = n + 1
            End If
        Next i

        a = Application.Transpose(a)
        ReDim Preserve a(1 To UBound(a, 1), 1 To n - 1)
        a = Application.Transpose(a)
        FilterArray = a
    End If
On Error GoTo 0
End Function

【讨论】：