Excel VBA - 循环的替代方法

Question

我有以下代码循环并根据是否满足某些条件复制某些信息（列AT =“Y”）。有很多数据要经过，所以我不认为这个循环是最有效的方法。 我对VBA的了解非常基础，从我读过的内容来看，我认为有一种更好的方法可以做到这一点，而不是一个搜索+1000条记录的循环。

非常感谢对此的任何帮助

谢谢，尼尔

Sheets("Data JPM Index").Select
Search_Row_1 = 12
Copy_Row_1 = 12
While Len(Range("A" & Search_Row_1).Value) > 0
If Range("AT" & Search_Row_1) = "Y" Then

Range("E" & Search_Row_1 & ":F" & Search_Row_1).Select
Selection.Copy
Range("AV" & Copy_Row_1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False

Range("A1").Select
Copy_Row_1 = Copy_Row_1 + 1

End If
Search_Row_1 = Search_Row_1 + 1
Wend

Answer 1

Sub Extract_Values1()

Dim wks As Worksheet
Dim startRow As Integer
Dim lastRow As Integer
Dim vArray As Variant
Dim vNewArray As Variant
Dim i As Integer, j As Integer
Dim Counter1 As Integer, Counter2 As Integer

startRow = 12
Set wks = Sheets("Data JPM Index")

With wks
    lastRow = .Cells(Rows.Count, 1).End(xlUp).row
    vArray = .Range("E" & startRow & ":AV" & lastRow).Value2
    For i = 1 To UBound(vArray)
        If vArray(i, 42) = "Y" Then
            Counter1 = Counter1 + 1
        End If
    Next i
  'ReDim vNewArray(1 To Counter1, 1 To 2)
   ReDim vNewArray(1 To Counter1, 1 To 5)
    For j = 1 To UBound(vArray)
        If vArray(j, 42) = "Y" Then
            Counter2 = Counter2 + 1
            vNewArray(Counter2, 1) = vArray(j, 1) 'Column E
            vNewArray(Counter2, 2) = vArray(j, 2) 'Column F
            vNewArray(Counter2, 3) = vArray(j, 21)'Column Y Newly Added
            vNewArray(Counter2, 4) = vArray(j, 22) 'Column Z Newly Added
            vNewArray(Counter2, 5) = vArray(j, 34) 'Column AL Newly Added
        End If
    Next

  '.Range("AV" & startRow & ":AW" & startRow + Counter1 - 1) = vNewArray
   .Range("AV" & startRow & ":AZ" & startRow + Counter1 - 1) = vNewArray

End With

End Sub

Answer 2

您可以使用自动筛选功能复制并粘贴所需的一小部分循环。

考虑这些数据：

下面的代码会将范围 TestData 的第6列（Col 6）的单元格 4 粘贴到单元格 H2 < /强>：

Sub Q31715032()
    With ThisWorkbook.Names("TestData").RefersToRange
        .AutoFilter 6, "=4" ' Want the 6th column with value 4
        .SpecialCells(xlCellTypeVisible).Copy Range("H2")
        '.AutoFilter ' Uncomment this to remove AutoFilter
    End With
End Sub

结果是：