Уважаемые форумчане, помогите, пожалуйста, адаптировать код под мои нужды. У самого ничего не получается.
Необходимо, чтобы поиск осуществлялся по строчке №6 до последней заполненной ячейки и выводил найденные значения в виде номера колонок, в которых они находятся. Поиск должен быть не точным (находить по части слова, например, ТОМСК, ТОМСКГАЗ, ЭНЕРГОТОМСК). Если это важно, то код будет находиться в одном файле (в юзерформе), а поиск осуществляться в другом. Большое спасибо!
P.S. Малые буквы - это комментарии, которые уже были в коде, когда я его нашел.
Большие - мои комментарии.
Код |
---|
Sub Poisk()Dim cell As Range,cellsDel As Range, cellAddress As String
With Workbooks("Книга1.xlsx").Sheets("Лист2").cells(6, Columns.Count).End(xlToLeft).Column.UsedRange ' ЗДЕСЬ, КАК Я ПОНИМАЮ, НУЖНО УКАЗАТЬ, ГДЕ ИСКАТЬ. УКАЗАЛ
' ЗДЕСЬ, ЧТО ИЩЕМ. УКАЗАЛ Set cell = .Find(Workbooks("Книга1.xlsx").Sheets("Лист1").Range("H2")) 'ищем первую попавшуЮсяIf Not cell Is Nothing Then 'если нашлиSet cellsDel = cell.Resize(2) 'сохраняем в переменную, увеличенную до 2 строк (Resize(2)) 'МНЕ НИЧЕГО УВЕЛИЧИВАТЬ НЕ НАДО
cellAddress = cell.Address 'запоминаем адрес, потому что FindNext будет искать по кругу и ее надо будет остановить
Do
Set cell = .FindNext(cell) 'продолжаем поиск после ячейки cell
If Not cell Is Nothing Then Set cellsDel = Union(cellsDel, cell.Resize(2)) 'если нашли, то добавляем в cellsDel ЗДЕСЬ ТОЖЕ ДВОЙКА В КОНЦЕ СМУЩАЕТ - УВЕЛИЧИВАТЬ НИЧЕГО НЕ НУЖНО 'DoEvents 'эту штуку можно ставить на стадии отладки, чтоб можно остановить Do...Loop в случае косяка
Loop Until cellAddress = cell.Address 'если дошли до адреса который уже был, выпадаем из Do...Loop
cellsDel.EntireRow.Delete 'удаляем строки принадлежащие ячейкам в переменной cellsDel МНЕ НЕ НУЖНО УДАЛЯТЬ - 'НУЖНО НОМЕРА КОЛОНОК СО ВСЕМИ НАЙДЕННЫМИ ЗНАЧЕНИЯМИ ВЫСТРОИТЬ В СТОЛБИК НА ЛИСТЕ Workbooks("Книга1.xlsx").Sheets("Лист1"), НАЧИНАЯ С ЯЧЕЙКИ I1.
End If
End With
End sub
' КОД БУДЕТ НАХОДИТЬСЯ В КНИГЕ Книга2.xlsb |