范围类的高级过滤方法失败

时间:2019-09-16 13:43:29

标签: excel vba

我遇到了以上错误。我试图寻找答案,发现很少但没有一个解决了我的问题。通常的解决方案是在发生过滤的地方激活工作表。如果它很重要,我将在Office 365中进行编码。

Private Sub CommandButton1_Click()
    Dim kryteria, cel, zrodlo As Range
    Dim lRow, lRow2 As Long
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim sc1, sc2, sc3 As Range

    Worksheets("Dies").Range("B4:J100").Value = ""
    Sheets("Dies").ListObjects("Wyniki").Resize Range("$B$3:$J$3")

    'Find the last non-blank cell in column A(1)
    lRow = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row

    If FDieSearch.Guma = "" Then
        Sheets("Dies").Cells(2, 2) = "=*"
    Else
        Sheets("Dies").Cells(2, 2) = "=" + FDieSearch.Guma
    End If

    If FDieSearch.Grubosc = "" Then
        Sheets("Dies").Cells(2, 3) = "=*"
        Sheets("Dies").Cells(2, 5) = "=*"
    Else
        Sheets("Dies").Cells(2, 3) = ">=" + CStr(Int(FDieSearch.Grubosc) - 1)
        Sheets("Dies").Cells(2, 5) = "<=" + CStr(Int(FDieSearch.Grubosc) + 1)
    End If

    If FDieSearch.Szerokosc = "" Then
        Sheets("Dies").Cells(2, 4) = "=*"
        Sheets("Dies").Cells(2, 6) = "=*"
    Else
        Sheets("Dies").Cells(2, 4) = ">=" + CStr(Int(FDieSearch.Szerokosc) - 2)
        Sheets("Dies").Cells(2, 6) = "<=" + CStr(Int(FDieSearch.Szerokosc) + 2)
    End If

    Set kryteria = Sheets("Dies").Range("B1:F2")
    Set cel = Sheets("Dies").Range("B3:j100")
    Set zrodlo = Sheets("Data").Range("A1:I" & lRow)

    zrodlo.CurrentRegion.AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=kryteria, _
        CopyToRange:=cel, _
        Unique:=False

    lRow2 = Sheets("Dies").Cells(Sheets("Dies").Rows.Count, "B").End(xlUp).Row
    Sheets("Dies").ListObjects("Wyniki").Resize Range("$B$3:$J$" & lRow2)

    Set ws = Sheets("Dies")
    Set tbl = ws.ListObjects("Wyniki")

    'Set sc1 = Range("Wyniki [STOCK]")
    Set sc2 = Range("Wyniki [Thickness]")
    Set sc3 = Range("Wyniki [Width]")

    With tbl.Sort
        .SortFields.Clear
        .SortFields.Add Key:=sc2, SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=sc3, SortOn:=xlSortOnValues, Order:=xlAscending
        .Header = xlYes
        .Apply
    End With
End Sub

程序应该根据用户表单FDieSearch中提供的值过滤数据表中的数据,将过滤后的数据复制到压模表中并对结果进行排序。但是它会继续使用AdvanceFilter方法。

enter image description here

enter image description here

1 个答案:

答案 0 :(得分:0)

我发现了一个错误,可以帮助我解决此问题。行:

Set zrodlo = Sheets("Data").Range("A1:I" & lRow)

缺少$ s并将其更改为:

Set zrodlo = Sheets("Data").Range("$A$1:$I$" & lRow)

已解决的错误问题。