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