Как я могу добавить это в массив?

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

Использование Range.CurrentRegion property изолировать «остров» данных, исходящих от А1 является простым способом ограничить области видимости операции. Вы не хотите копировать тысячи пустых ячеек в массив.

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 в пределах Range.SpecialCells method «s xlCellTypeVisible набора. Используйте F8, чтобы просмотреть код, не отрывая глаз от окна Immediate 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

Моя идея заключается в том, чтобы создать диапазон накидной uRng, но я не мог заполнить его в массив таким образом, создать временную таблицу и мимо этого диапазона в нем затем залейте выделение (скопированный диапазон) в массиве, затем удалите этот временный лист.

это будет работать, но я не знаю, если это хороший способ, так что это просто идея, потому что Jeeped answer кажется полный ответ на этот вопрос

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