根据条件列表过滤信息

时间:2019-04-05 08:34:34

标签: vba

我有两个文件,X和Y。我想根据X文件中的信息过滤Y文件中的数据。

在X文件中,有两列。

A列-标题名称

项目
项目
状态
地区
地区

B列-过滤条件

盒子 鞋类 已批准 亚太地区 欧洲,中东和非洲地区

逻辑是 1.循环并从X文件的第一列(标题名称-项)中读取信息。 2.在Y文件中找到匹配的列标题。返回列地址。 3.根据X文件,根据条件(过滤条件框)过滤Y文件中的列。

对于行“ Headercell = Application.WorksheetFunction.Match(Header,Targetsht.Range(Cells(1,1),Cells(1,50)),0)”行无效。它弹出错误“未设置对象变量或With块变量

    Sub Removeitems()

    'Set files
    Dim listwbk As Workbook
    Dim listsht As Worksheet
    Dim lastrow As Long
    Dim list As Range


    Dim Targetwbk As Workbook
    Dim Targetsht As Worksheet
    Dim TPath As String

    Dim Header As String
    Dim Itm As String
    Dim Headercell As Range
    Dim columnnumber As Long

    Dim Rng As Range
    Dim Rng_Del As Range

    Set listwbk = Workbooks("Macro for uploading data.xlsm")
    Set listsht = listwbk.Sheets(2)
    Set Targetwbk = Workbooks("Standard Format.xlsb")
    Set Targetsht = Targetwbk.Sheets(1)

    lastrow = listsht.Cells(listsht.Rows.Count, 1).End(xlUp).Row

    ' Select cell A2, *first line of data*.
    Set list = listsht.Range("A1")

Dim i As Long
    ' Use LastRow in loop
        For i = 2 To lastrow
            Header = listsht.Cells(i, 1).Value
            Itm = listsht.Cells(i, 2).Value

                'Apply autofilter to data rage
                'Note: data must start in cell A1 for this macro to work
                Set Rng = Targetsht.Range("A1").CurrentRegion

                        If Targetsht.AutoFilterMode = True Then
                           Targetsht.AutoFilter.ShowAllData
                        End If

                        'Headercell = Targetsht.Range("1:1").Find(What:="Part number", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
                        Headercell = Application.WorksheetFunction.Match(Header, Targetsht.Range(Cells(1, 1), Cells(1, 50)), 0)

                        If Headercell Is Nothing Then
                        Debug.Print "Name was not found."
                        Else
                        Debug.Print "Name found in :" & Headercell.Address
                        End If


                        columnnumber = Headercell.column

                        Rng.AutoFilter field:=columnnumber, Criteria1:=Itm
                         'Delete visible rows assuming there's nothing else below the last row
                         Rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

                            Targetwbk.Sheets(1).AutoFilterMode = False

     ' Step down 1 row from present location.
     ActiveCell.Offset(1, 0).Select
  Next

结束子

0 个答案:

没有答案