Question

我的代码没有刷新自动过滤器。对于i = 8代码有效，但在下一个i，它不会更新自动过滤器字段。＆＃34; no_filtered_rows＆＃34;显示0行（应该有）。

For i = 8 To ostD 
accounts() = Split(Worksheets("k").Range("B" & i).Value, ",") 

For j = 0 To UBound(accounts) 
    sAccNo = Trim(accounts(j)) 

    Set rFind = .Cells.Find(sAccNo) 

    If Not rFind Is Nothing Then 

        .ShowAllData 

        .Range("A1:G" & ostD).AutoFilter Field:=3, Criteria1:=rFind 


        no_filtered_rows = .Range("A1:G" & ostD).SpecialCells(xlCellTypeVisible).Rows.Count - 1

Answer 1

Sub insert() 
Dim i As Long, j As Long, k As Long, no_rows_filter As Integer 

With Application 
    .DisplayAlerts = False 
    .ScreenUpdating = False 
    .EnableEvents = False 
    .Calculation = xlManual 

    LastRow_dane = Worksheets("dane").Range("A" & Rows.Count).End(xlUp).Row 

    wbk.Worksheets("dane").Activate 

    With ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.Range(Cells(1, 1), Cells(LastRow_dane, 7)), , xlYes) 
        .Name = "Tabela1" 
        .TableStyle = "TableStyleLight1" 
    End With 

    LastRow_konta = Worksheets("konta").Range("A" & Rows.Count).End(xlUp).Row 
    Sheets("konta").Range("C4:G" & LastRow_konta).Clear 


    On Error Resume Next 
    Worksheets("konta").Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 

    ost = Worksheets("konta").Cells(.Rows.Count, "A").End(xlUp).Row 

    Dim accounts() As String 
    Dim sAccNo As String 
    Dim rFind As Range, rCopy As Range 

    With Worksheets("dane") 
        ostD = .Cells(.Rows.Count, "C").End(xlUp).Row 

        For i = 8 To ostD 

            accounts() = Split(Worksheets("konta").Range("B" & i).Value, ",") 

            For j = 0 To UBound(accounts) 
                sAccNo = Trim(accounts(j)) 

                Set rFind = .Cells.Find(sAccNo) 

                If Not rFind Is Nothing Then 

                    .ShowAllData 

                    .Range("A1:G" & ostD).AutoFilter Field:=3, Criteria1:=rFind 
                    no_rows_filter = .Range("A1:G" & ostD).SpecialCells(xlCellTypeVisible).Rows.Count - 1 

                    Sheets("konta").Rows(i + 1).EntireRow.Resize(no_rows_filter).Insert 

                    .Range("I2").Value = rFind 

                    Dim r As Range 

                    Set r = Sheets("konta").Range("C" & i + 1 & ":I" & i + 1) 

                    .Range("Tabela1[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _ 
                    .Range("I1:I2"), CopyToRange:=r, Unique:=False 
                    r.Delete xlShiftUp 


                End If 

            Next j 

            i = i + no_rows_filter + 1 

        Next i 

    End With 

    .DisplayAlerts = True 
    .ScreenUpdating = True 
    .EnableEvents = True 
    .Calculation = xlAutomatic 

End With

End Sub

自动过滤器在更改时不会令人耳目一新

1 个答案: