Excel VBA中自動篩選

Question

我試圖寫一個宏來執行以下操作後，選擇除頭部所有過濾行：

• 從工作表Sheet1監視數據I輸入的A柱;
• 當我在A列的單元格中寫入內容時，使用該值來過濾Sheet2;
• 過濾完成後，即使有多個值，也會將第二張表格中除列標題以外的所有內容複製到第一張表格中。

我試着寫這樣的：

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim KeyCells As Range 
    Set KeyCells = Range("A:A") 
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _ 
      Is Nothing Then 
     copy_filter Target 
    End If 
End Sub 

Sub copy_filter(Changed) 
    Set sh = Worksheets("Sheet2") 
    sh.Select 

    sh.Range("$A$1:$L$5943") _ 
     .AutoFilter Field:=3, _ 
      Criteria1:="=" & Changed.Value, _ 
      VisibleDropDown:=False 
    Set rang = sh.Range("$A$1:$L$5943") _ 
     .SpecialCells(xlCellTypeVisible) 

    rang.Offset(0, 0).Select 
    Selection.Copy 

    Worksheets("Sheet1").Select 
    Worksheets("Sheet1").Range(Changed.Address).Offset(0, 1).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 

    sh.Range("$A$1:$L$5943").AutoFilter 
    Application.CutCopyMode = False 
End Sub 

然而，當我複製標題行被複制以及選擇，但使用.Offset（1,0）切頭和1個排，沒有按沒有考慮到過濾器沒有返回結果的情況。

如何選擇除標題以外的每個過濾行？

Answer 1

使用sh.UsedRange會給你一個動態範圍。在那裏，sh.Range("$A$1:$L$5943")不會縮小和增長以匹配您的數據集。
我們可以修剪標題行過這樣的：如果沒有數據返回

Set rang = sh.UsedRange.Offset(1, 0) 
    Set rang = rang.Resize(rang.Rows.Count - 1) 

但SpecialCells(xlCellTypeVisible)將拋出一個No cells were found.錯誤。因此，我們將不得不陷阱這樣的錯誤：

On Error Resume Next 

Set rang = rang.SpecialCells(xlCellTypeVisible) 

If Err.Number = 0 Then 

End If 

On Error GoTo 0 

 
    Sub copy_filter(Changed) 
     Dim rang As Range 

     Set sh = Worksheets("Sheet2") 

     sh.UsedRange.AutoFilter Field:=3, _ 
           Criteria1:="=" & Changed.Value, _ 
           VisibleDropDown:=False 


     Set rang = sh.UsedRange.Offset(1, 0) 
     Set rang = rang.Resize(rang.Rows.Count - 1) 

     On Error Resume Next 
     Set rang = rang.SpecialCells(xlCellTypeVisible) 
     If Err.Number = 0 Then 
      rang.Copy 
      Worksheets("Sheet1").Range(Changed.Address).Offset(0, 1).PasteSpecial Paste:=xlPasteValues 
     End If 

     On Error GoTo 0 

     sh.Cells.AutoFilter 

     Application.CutCopyMode = False 


    End Sub