На Листе1 в столбцеА есть список слов/цифр (могут быть любые значения, могут располагаться не сплошняком, т.е. через две/три ячейки), На листе 2 есть список предложений, По запуску макроса нужно удалить все предложения с Листа2, в которых содержатся все слова/значения Листа1/столбецА (слово может быть в любой части предложения, или предложение может быть лишь этим словом). Те предложения, которые удалили, нужно вывести списком в Лист3/Столбец1 (этот список нужно не перезаписывать при каждом нажатии, а добавлять в конец списка), т.е. если добавить еще 1 слово в Лист1 и нажать кнопку, макрос найдет это слово в предложении Листа2, удалит его с Листа2 и допишет в Ссписок Листа3.
Файл прикрепил Спасибо заранее)))
Добрый день.
Очень нужна помощь в создании макроса:
На Листе1 в столбцеА есть список слов/цифр (могут быть любые значения, могут располагаться не сплошняком, т.е. через две/три ячейки), На листе 2 есть список предложений, По запуску макроса нужно удалить все предложения с Листа2, в которых содержатся все слова/значения Листа1/столбецА (слово может быть в любой части предложения, или предложение может быть лишь этим словом). Те предложения, которые удалили, нужно вывести списком в Лист3/Столбец1 (этот список нужно не перезаписывать при каждом нажатии, а добавлять в конец списка), т.е. если добавить еще 1 слово в Лист1 и нажать кнопку, макрос найдет это слово в предложении Листа2, удалит его с Листа2 и допишет в Ссписок Листа3.
Макрос в стандартный модуль, запускать при активном листе Лист1 [vba]
Код
Sub Poisk() Dim List3 As Worksheet Dim Slovo As String Dim MyArr Dim i As Integer Dim iLastRow As Integer Dim j As Integer Dim iLR_2 As Integer Dim iLR_3 As Integer Dim k As Integer Set List3 = ThisWorkbook.Worksheets("Лист3") iLastRow = Cells(Rows.Count, "A").End(xlUp).Row With Worksheets("Лист2") For i = 2 To iLastRow iLR_2 = .Cells(Rows.Count, "A").End(xlUp).Row If Not IsEmpty(Cells(i, "A")) Then Slovo = Cells(i, "A") For j = iLR_2 To 2 Step -1 If InStr(1, .Cells(j, "A"), Slovo) <> 0 Then MyArr = Split(.Cells(j, "A"), " ") For k = 0 To UBound(MyArr) If MyArr(k) = Slovo Then iLR_3 = List3.Cells(List3.Rows.Count, "A").End(xlUp).Row + 1 List3.Cells(iLR_3, "A") = .Cells(j, "A") .Rows(j).Delete Exit For End If Next End If Next End If Next End With End Sub
[/vba]
Макрос в стандартный модуль, запускать при активном листе Лист1 [vba]
Код
Sub Poisk() Dim List3 As Worksheet Dim Slovo As String Dim MyArr Dim i As Integer Dim iLastRow As Integer Dim j As Integer Dim iLR_2 As Integer Dim iLR_3 As Integer Dim k As Integer Set List3 = ThisWorkbook.Worksheets("Лист3") iLastRow = Cells(Rows.Count, "A").End(xlUp).Row With Worksheets("Лист2") For i = 2 To iLastRow iLR_2 = .Cells(Rows.Count, "A").End(xlUp).Row If Not IsEmpty(Cells(i, "A")) Then Slovo = Cells(i, "A") For j = iLR_2 To 2 Step -1 If InStr(1, .Cells(j, "A"), Slovo) <> 0 Then MyArr = Split(.Cells(j, "A"), " ") For k = 0 To UBound(MyArr) If MyArr(k) = Slovo Then iLR_3 = List3.Cells(List3.Rows.Count, "A").End(xlUp).Row + 1 List3.Cells(iLR_3, "A") = .Cells(j, "A") .Rows(j).Delete Exit For End If Next End If Next End If Next End With End Sub