Нужен скрипт для Excel, который удаляет строки по списку слов

Question

У меня есть список слов в столбце A 2-го листа, и мне нужен скрипт для Excel, который выполняет следующие действия:

1) Проверяет первое слово столбца A на 2-м листе и затем фильтруетстолбец B 1-й лист по ячейкам, содержащим это слово.

2) Удаляет все уже отфильтрованные строки, не содержащие этого слова, также в столбце C.

И затем выполняется итерация со следующимслово из столбца A списка 2-го листа, пока не пройдут все слова.

Пример:

Столбец A 2-й лист: hav

Столбец B 1-й лист: есть

Столбец C 1-й лист: должен

В этом случае будет удалена вся строка, потому что хотя столбец B содержит «hav», столбец C - нет.

Извините за мой английскийЯ из Аргентины:)

Спасибо!

Answer 1

Удалить столбец по критериям

Ссылки

Загрузка рабочей книги

Код

Sub DeleteColumnCriteria()

    ' Worksheet 1
    Const csheet1 As Variant = "Sheet1"   ' Worksheet Name/Index
    Const cFirstR1 As Long = 2            ' First Row
    Const cCol1 As Variant = "B"          ' Criteria Column 1
    Const cCol2 As Variant = "C"          ' Criteria COlumn 2
    ' Worksheet 2
    Const cSheet2 As Variant = "Sheet2"   ' Worksheet Name/Index
    Const cFirstR2 As Long = 2            ' First Row
    Const cCol As Variant = "A"           ' Criteria Column

    ' Worksheet 1
    Dim rngU As Range     ' Union Range
    Dim LastR1 As Long    ' Last Row Number
    Dim i As Long         ' Row Counter
    ' Worksheet 2
    Dim ws2 As Worksheet  ' Worksheet 2
    Dim LastR2 As Long    ' Last Row Number
    Dim j As Long         ' Row Counter

    Application.ScreenUpdating = False

    ' Calculate Last Row of Worksheet 2.
    Set ws2 = ThisWorkbook.Worksheets(cSheet2)
    LastR2 = ws2.Cells(ws2.Rows.Count, cCol).End(xlUp).Row

    With ThisWorkbook.Worksheets(csheet1)

        ' Calculate Last Row of Worksheet 1.
        LastR1 = .Cells(.Rows.Count, cCol1).End(xlUp).Row

        ' Accumulate ranges into Union Range.
        For i = cFirstR2 To LastR2 ' Loop through rows in Worksheet 2.
            For j = cFirstR1 To LastR1  ' Loop through rows in Worksheet 1.
                ' When value in cCol in Worksheet 2 is equal to cCol1 and
                ' not in cCol2 in Worksheet 1.
                If ws2.Cells(i, cCol) <> "" Then
                    If ws2.Cells(i, cCol) = .Cells(j, cCol1) _
                            And ws2.Cells(i, cCol) <> .Cells(j, cCol2) Then
                        If Not rngU Is Nothing Then   ' All other times.
                            Set rngU = Union(rngU, .Cells(j, 1))
                          Else                        ' First time only.
                            Set rngU = .Cells(j, 1)
                        End If
                    End If
                End If
            Next
        Next

    End With

    ' Delete rows in one go.
    If Not rngU Is Nothing Then
        rngU.EntireRow.Delete ' Hidden = True
    End If

    Application.ScreenUpdating = True

End Sub

Answer 2

Ваше описание довольно скудное, но я дал ему шанс.Попробуйте этот код на «Лист1».Замените «Лист2» ​​на имя второго Листа.Это позволит изучить каждую работу на «Листе 2» и удалить все строки на Листе1, столбец B которых содержит это слово.Не уверен, что вы подразумеваете под столбцом C, но это условие должно быть легко добавить.

Дайте мне знать.

    Sub Test()

    Dim LastRow As Long
    Dim LastRowS2 As Long
    Dim Word As String

    LastRowS2 = ThisWorkbook.Sheets("Sheet2").Cells(1, 1).End(xlDown).Row
    LastRow = Cells(1, 1).End(xlDown).Row

    For i = 2 To LastRowS2
        For j = 2 To LastRow
            Word = Split(ThisWorkbook.Sheets("Sheet2").Cells(i, "A").Text, " ")(0)
            If InStr(Cells(j, "B").Text, Word) > 0 Then
                If InStr(Cells(j, "C").Text, Word) > 0 Then
                    'Do nothing
                Else
                    Cells(j, "B").EntireRow.Delete
                    j = j - 1
                End If
            End If
        Next j
    Next i

End Sub