Excel VBA循环直到答案

【问题标题】：Excel VBA loop untilExcel VBA循环直到
【发布时间】：2016-02-01 22:48:46
【问题描述】：

我正在使用以下if 代码通过F1 中的值过滤col A 和col B

排序后，我将过滤后的值复制到col A 中，并将它们粘贴到范围值下。

然后我转到下一个范围并使用不同的范围值重复过滤器（在本例中为单元格 G1）。

我需要从单元格 F1 到单元格 AH1 重复此操作。

我可以使用循环来执行此操作吗？

If Range("F1").Value <> "" Then

    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$B" & LastRow).AutoFilter Field:=2, Criteria1:=Range("F1").Value

    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFilter
    Range("A1").Select

End If

If Range("G1").Value <> "" Then

    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$B" & LastRow).AutoFilter Field:=2, Criteria1:=Range("G1").Value

    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFilter
    Range("A1").Select

End If

【问题讨论】：

标签： vba excel loops

【解决方案1】：

试试下面的循环。我已将您的代码重构为不使用 ActiveSheet 和 Select 语句。相反，我将所有对象和方法限定为它们的父对象并直接使用该对象。它将避免代码的预期结果与实际结果中的许多陷阱和错误。

Dim LastRow As Long
'assume LastRow already set

Dim ws As Worksheet
Set ws = Worksheets("Sheet1") 'change as needed

With ws

    Dim cel As Range
    For Each cel In .Range("F1:AH1")
        If Len(cel) > 0 Then
            ws.UsedRange.AutoFilter
            .Range("A2:B" & LastRow).AutoFilter Field:=2, Criteria1:=cel.Value
            .Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).Copy Destination:=cel.Offset(1)
        End If
    Next

End With

见How to Avoid Select

【讨论】：