Question

我的代码将表数据复制到一个数组中，然后将该数组复制到主文件到一个表中。

有什么办法可以在将数据复制到过滤器时使其处于活动状态。现在，当我复制数据时，我每次都必须重新应用过滤器。

（过滤器未设置为特定值并且可以更改）我想我的问题是，有没有办法刷新过滤器？

Option Explicit


Sub readingarray()
Application.DisplayAlerts = False

Dim table_list_object As ListObject
Dim table_object_row As ListRow
Dim arr
Dim Itm
Dim rng As Range
Dim stringarray As Variant
Dim rowcount As Long, columncount As Long
'array of work files
stringarray = Array("test.xlsm", "test 2.xlsm", "test 3.xlsm", "test 4.xlsm", "test 5.xlsm", _
                    "test 6.xlsm", "test 7.xlsm", "test 8.xlsm", "test 9.xlsm", "test 10.xlsm", _
                    "test 11.xlsm", "test 12.xlsm")

     On Error Resume Next
     
    
      'copy shibuzim table from work files to main files including only filtered celled
        For Each Itm In stringarray
           arr = GetArrayFromFilteredRange(Workbooks(Itm).Worksheets("shibuz").ListObjects("LeaveTracker").DataBodyRange.SpecialCells(xlCellTypeVisible))
             Set table_list_object = Workbooks("shibuzim 2 updated.xlsm").Worksheets("shibuz").ListObjects("LeaveTracker")
             Set table_object_row = table_list_object.ListRows.Add
    
        
             rowcount = UBound(arr, 1)
             columncount = UBound(arr, 2)
             table_object_row.Range(1, 1).Resize(rowcount - 1, columncount - 1).Value = arr
        Next Itm
        
      On Error GoTo 0
    End Sub
    'function to filter only filtered cells
    Function GetArrayFromFilteredRange(rng As Range) As Variant
        Dim arr As Variant
       'copy to help sheet
       helper.Cells.Clear
       
        rng.Copy helper.Range("A1")
        arr = helper.UsedRange.Value
        
        GetArrayFromFilteredRange = arr
End Function

Answer 1

Private Sub Worksheet_Change(ByVal Target As Range)
   Sheets("shibuz").AutoFilter.ApplyFilter
End Sub

将数据复制到表但保持过滤器处于活动状态

1 个答案: