Фильтровать информацию на основе списка критериев - PullRequest
0 голосов
/ 05 апреля 2019

У меня есть два файла, X и Y. Я хочу отфильтровать данные в Y-файле на основе информации в X-файле.

В X-файле есть два столбца.

Столбец A - Имя заголовка

Элемент
Элемент
Статус
Область
Область

Столбец B - Критерии фильтра

Одобренные коробчатые ботинки APAC EMEA

Логика: 1. Зациклите и прочитайте информацию из первого столбца (заголовок name-Item) в X-файле.2. Найдите соответствующий заголовок столбца в Y-файле.Вернуть адрес столбца.3. Отфильтруйте столбец в Y-файле на основе критериев (Filter Criteria-Box) по X-файлу.

Для строки "Headercell = Application.WorksheetFunction.Match (Header, Targetsht.Range (Ячейки (1, 1), Ячейки (1, 50)), 0) «Не работает. Появляется ошибка». Переменная объекта или переменная блока не установлена ​​

    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

End Sub

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...