名称范围,然后自动过滤

时间:2018-04-03 15:43:36

标签: vba excel-vba excel

我有两张纸。 Sheet1(PasteHere)在col B中有一长串值。例如:

100000
100100
100800
100801
200501
etc

Sheet2(Landing)有一个我需要过滤的列表。例如:

100000
100801

最终结果是我希望表单1中的值按表单2中的值进行过滤。我想我可以在表单2中命名范围,然后按它进行过滤,但它不起作用。这是我到目前为止的代码。我命名范围“CustList”

Sub FilterList()

Sheets("Landing").Select
Dim LastRow1 As Long
LastRow1 = Range("B" & Rows.Count).End(xlUp).Row

Range("B15:B" & LastRow1).Select
ActiveWorkbook.Names.Add Name:="CustList", RefersToR1C1:= _
    "=Landing!R15C2:R[" & LastRow1 & "]C2"
Range("E16").Select

Dim vCrit As Variant
Dim rngCrit As Range
Set rngOrders = Sheets("PasteHere").Range("$A$1").CurrentRegion
Set rngCrit = Sheets("Landing").Range("CustList")

vCrit = rngCrit.Value

Sheets("PasteHere").Select
rngOrders.AutoFilter _
Field:=2, _
Criteria1:=Application.Transpose(vCrit), _
Operator:=xlFilterValues

End Sub

2 个答案:

答案 0 :(得分:0)

使用以下代码。

Dim LastRow1, LastRow2, iLoop

Sheets("Landing").Select

LastRow1 = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row



ReDim xarr(LastRow1 - 14)


For iLoop = 1 To LastRow1 - 14
    xarr(iLoop) = ActiveSheet.Range("B" & iLoop)
Next

Sheets("PasteHere").Select
LastRow2 = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("B1").Select
Selection.AutoFilter
ActiveSheet.Range("$B$1:$B$" & LastRow2).AutoFilter Field:=1, Criteria1:=xarr, Operator:=xlFilterValues

答案 1 :(得分:0)

试试这段代码:

Option Explicit

Sub FilterRange()
'declaration of variables
Dim filterBy As Variant, toFilter As Variant, lastRow1 As Long, lastRow2 As Long, i As Long, j As Long, k As Long, _
filtered As Variant, ws1 As Worksheet, ws2 As Worksheet, flag As Boolean
k = 1
flag = True
'set references to worksheets, it's good to use them when you deal with more than one worksheet
'REMEMBER: use your own sheet name and change ranges I used (I used A column)
Set ws1 = Worksheets("Arkusz1")
Set ws2 = Worksheets("Arkusz2")
'set the ranges (storethem as arrays): to filter and one to filter by
lastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
toFilter = ws1.Range("A1:A" & lastRow1).Value2
'clear range, we will write here filtered values
ws1.Range("A1:A" & lastRow1).Clear
lastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
filterBy = ws2.Range("A1:A" & lastRow1).Value2

'here you loop thorugh arrays, checking if one element is in the other array
'if it isn't, write this value to cell on ws1
For i = 1 To lastRow1
    flag = True
    For j = 1 To lastRow2
        If toFilter(i, 1) = filterBy(j, 1) Then
            flag = False
            Exit For
        End If
    Next

    If flag Then
        ws1.Cells(k, 1).Value = toFilter(i, 1)
        k = k + 1
    End If
Next

End Sub