我怎么能把这个添加到数组？

我一直在试图将符合高亮标准的整行添加到数组中，但是我一直在努力让它工作。

代码通过多个标识符循环，并根据前提条件以红色突出显示。 我想将整行添加到满足前提条件的所有行的数组。

Sub SWAPS101() 'red color ' If "Security Type" = SW ' If "New Position Ind" = N ' If "Prior Price" = 100 ' If "Current Price" does not equal 100 Dim rng As Range, lCount As Long, LastRow As Long Dim cell As Object 'Sheets("Output").Activate With ActiveSheet LastRow = .Cells(Rows.Count, 1).End(xlUp).Row For Each cell In .Range("E2:E" & LastRow) 'new position If cell = "N" And cell.Offset(, 16) = "SW" And cell.Offset(, 5) = 100 _ And cell.Offset(, 4) <> 100 Then With cell.EntireRow.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 6382079 .TintAndShade = 0 .PatternTintAndShade = 0 End With ' LastRow = Range("b65000").End(xlUp).Row ' For r = 2 To LastRow Row = Row + 1 TempArray(Row, 1) = Cells(r, cell)) Next r End If Next cell End With End Sub 

Answer 1

使用Range.CurrentRegion属性来隔离从A1辐射出来的数据是一个简单的方法来限制操作的“范围”。 您不希望将数千个空白单元格复制到数组中。

 Sub SWAPS101() 'red color ' If "Security Type" = SW ' If "New Position Ind" = N ' If "Prior Price" = 100 ' If "Current Price" does not equal 100 Dim a As Long, r As Long, c As Long, vVALs As Variant With Sheets("Output") 'reset the environment If .AutoFilterMode Then .AutoFilterMode = False .Columns(5).Interior.Pattern = xlNone With .Cells(1, 1).CurrentRegion ReDim vVALs(1 To .Columns.Count, 1 To 1) .AutoFilter field:=Application.Match("security type", .Rows(1), 0), Criteria1:="SW" .AutoFilter field:=Application.Match("new position ind", .Rows(1), 0), Criteria1:="N" .AutoFilter field:=Application.Match("prior price", .Rows(1), 0), Criteria1:=100 .AutoFilter field:=Application.Match("current price", .Rows(1), 0), Criteria1:="<>" & 100 With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0) 'check to ensure that there is something to work with If CBool(Application.Subtotal(103, .Cells)) Then With Intersect(.Columns(5), .SpecialCells(xlCellTypeVisible)) .Cells.Interior.Color = vbRed End With Debug.Print .SpecialCells(xlCellTypeVisible).Areas.Count With .SpecialCells(xlCellTypeVisible) For a = 1 To .Areas.Count Debug.Print .Areas(a).Rows.Count For r = 1 To .Areas(a).Rows.Count Debug.Print .Areas(a).Rows(r).Address(0, 0) ReDim Preserve vVALs(1 To UBound(vVALs, 1), 1 To UBound(vVALs, 2) + 1) For c = 1 To .Columns.Count vVALs(c, UBound(vVALs, 2)) = _ .Areas(a).Rows(r).Cells(1, c).Value Next c Next r Next a vVALs = Application.Transpose(vVALs) End With 'array is populated - do something with it Debug.Print LBound(vVALs, 1) & ":" & UBound(vVALs, 1) Debug.Print LBound(vVALs, 2) & ":" & UBound(vVALs, 2) 'this dumps the values starting a couple of rows down With .Cells(.Rows.Count, 1).Offset(3, 0) .Resize(UBound(vVALs, 1), UBound(vVALs, 2)) = vVALs End With End If End With End With If .AutoFilterMode Then .AutoFilterMode = False End With End Sub 

我已经留下了很多debug.print语句，所以你可以看到如何通过Range.SpecialCells方法的xlCellTypeVisible集合中的每个Range.Areas属性的行循环这个过程。 使用F8逐步浏览代码，同时留意VBE的立即窗口（[Ctrl] + G）。

^{后处理结果}

Answer 2

您可以将范围添加到数组，例如：

 Dim myArray() As Variant 'declare an unallocated array. myArray = Range("E2:E" & LastRow) 'myArray is now an allocated array, range being your row 

Answer 3

我的想法是创build联合范围uRng但我不能填充它的数组，所以创build临时工作表，并超过这个范围，然后填充select（复制的范围）在数组中，然后删除此临时工表。

这将工作，但我不知道这是不是好方法，所以这只是一个想法，因为Jeeped答案似乎是这个问题的完整答案

 Sub SWAPS101() 'red color ' If "Security Type" = SW ' If "New Position Ind" = N ' If "Prior Price" = 100 ' If "Current Price" does not equal 100 Dim rng As Range, lCount As Long, LastRow As Long Dim cell As Range Dim TempArray As Variant, uRng As Range, tempSH As Worksheet 'Sheets("Output").Activate With ActiveSheet LastRow = .Cells(Rows.Count, 1).End(xlUp).Row For Each cell In .Range("E2:E" & LastRow) 'new position If cell = "N" And cell.Offset(, 16) = "SW" And cell.Offset(, 5) = 100 _ And cell.Offset(, 4) <> 100 Then With cell.EntireRow.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 6382079 .TintAndShade = 0 .PatternTintAndShade = 0 End With If uRng Is Nothing Then Set uRng = cell.EntireRow Else Set uRng = Union(uRng, cell.EntireRow) End If End If Next cell End With If Not uRng Is Nothing Then Application.ScreenUpdating = False Set tempSH = Sheets.Add uRng.Copy tempSH.Paste TempArray = Selection.Value Application.DisplayAlerts = False tempSH.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End If End Sub