我怎么能把它添加到数组中？

Question

我一直在尝试将满足突出显示条件的整行添加到一个数组中，但我一直在努力让它工作。

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

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

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

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

Answer 2

利用Range.CurrentRegion property隔离A1辐射出的'island'数据，是限制'scope'运算的简便方法。您不希望将数千个空白单元格复制到一个数组中。

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.Areas property within the Range.SpecialCells method's xlCellTypeVisible 集的行。使用 F8 单步执行代码，同时关注 VBE 的即时 window ([Ctrl]+G).

^{Post-processing 结果}

Answer 3

我的想法是创建联合范围 uRng 但我无法将其填充到数组中，因此创建临时 sheet 并在其中超过此范围，然后在其中填充选择（复制的范围） array 然后删除这个 temp sheet.

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

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

我怎么能把它添加到数组中？

How could I add this to an array?

excel

vba

excel-2007