Excel VBA中循环，直到

Question

我使用下面的代码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 

Answer 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