Добрый день Подобную тему недавно поднимал, однако появились нюансы, которые самостоятельно методом проб не решил. В столбце C есть слово "от Заказчика / Owner", которое находится в нескольких ячейках. Нужно от самой нижней ячейки, содержащей текст "от Заказчика / Owner" удалить все строки что ниже (т.е. удалить 999 строк либо до последней заполненной по столбцу C, либо массив от A до AA). Прошу вашей помощи, т.к. эти кода: [vba]
Код
Dim urar As Range, row1ar As Long, row2ar As Long Set urar = ActiveSheet.UsedRange row1ar = Columns("C").Find("от Заказчика / Owner").Row row2ar = urar.Row + urar.Rows.Count + 1 Columns("A:BK").Resize(row2ar - row1ar).Offset(row1ar).Delete
[/vba] удаляют от первого слова "от Заказчика / Owner"
Добрый день Подобную тему недавно поднимал, однако появились нюансы, которые самостоятельно методом проб не решил. В столбце C есть слово "от Заказчика / Owner", которое находится в нескольких ячейках. Нужно от самой нижней ячейки, содержащей текст "от Заказчика / Owner" удалить все строки что ниже (т.е. удалить 999 строк либо до последней заполненной по столбцу C, либо массив от A до AA). Прошу вашей помощи, т.к. эти кода: [vba]
Код
Dim urar As Range, row1ar As Long, row2ar As Long Set urar = ActiveSheet.UsedRange row1ar = Columns("C").Find("от Заказчика / Owner").Row row2ar = urar.Row + urar.Rows.Count + 1 Columns("A:BK").Resize(row2ar - row1ar).Offset(row1ar).Delete
Добрый день. Насколько я понял. Необходимо найти последнее вхождение... Тогда Вам в помощь небольшая функция:
[vba]
Код
Function FindDownCell(FindRange As Range, StrFind As String) As Range 'Поиск последнего значения и возврат ячейки как объект Dim firstAddress Dim c As Range: Set c = FindRange.Find(What:=StrFind, LookIn:=xlFormulas, LookAt:=xlPart) ' собственно поиск ' если ничего не нашли - выход If c Is Nothing Then Exit Function 'MsgBox "Искомые данные не найдены", vbExclamation: firstAddress = c.Address Do Set FindDownCell = c Set c = FindRange.FindNext(c) Loop While c.Address <> firstAddress End Function
[/vba]
Добрый день. Насколько я понял. Необходимо найти последнее вхождение... Тогда Вам в помощь небольшая функция:
[vba]
Код
Function FindDownCell(FindRange As Range, StrFind As String) As Range 'Поиск последнего значения и возврат ячейки как объект Dim firstAddress Dim c As Range: Set c = FindRange.Find(What:=StrFind, LookIn:=xlFormulas, LookAt:=xlPart) ' собственно поиск ' если ничего не нашли - выход If c Is Nothing Then Exit Function 'MsgBox "Искомые данные не найдены", vbExclamation: firstAddress = c.Address Do Set FindDownCell = c Set c = FindRange.FindNext(c) Loop While c.Address <> firstAddress End Function
Спасибо большое. Подскажите, пожалуйста, чтобы её вызвать из основного кода, то нужно в коде просто прописать (в нужном месте и в модуль саму функцию сохранив) [vba]
Спасибо большое. Подскажите, пожалуйста, чтобы её вызвать из основного кода, то нужно в коде просто прописать (в нужном месте и в модуль саму функцию сохранив) [vba]
Не люблю Финды, бывает, что зависает на них. Вот такой вариант
[vba]
Код
Sub tt() r1_ = Cells(1).SpecialCells(xlLastCell).Row ar_ = Cells(1, 3).Resize(r1_).Value t_ = "от Заказчика / Owner" For i = r1_ To 1 Step -1 If ar_(i, 1) = t_ Then fl_ = 1 Cells(i + 1, 1).Resize(r1_ - i + 1).EntireRow.Delete Exit For End If Next i If fl_ <> 1 Then MsgBox "Текст ''" & t_ & "'' не найден." End If End Sub
[/vba]
Не люблю Финды, бывает, что зависает на них. Вот такой вариант
[vba]
Код
Sub tt() r1_ = Cells(1).SpecialCells(xlLastCell).Row ar_ = Cells(1, 3).Resize(r1_).Value t_ = "от Заказчика / Owner" For i = r1_ To 1 Step -1 If ar_(i, 1) = t_ Then fl_ = 1 Cells(i + 1, 1).Resize(r1_ - i + 1).EntireRow.Delete Exit For End If Next i If fl_ <> 1 Then MsgBox "Текст ''" & t_ & "'' не найден." End If End Sub
Dim urar As Range, row1ar As Long, row2ar As Long, NomerStroki As Variant Set urar = ActiveSheet.UsedRange NomerStroki = FindDownCell(urar, "от Заказчика / Owner").Row + 1 '+1,т.к. оставляем строку с "от Заказчика" lRow = Cells.SpecialCells(xlLastCell).Row
[/vba] Получил два номера строк: NomerStroki - верхняя и lRow - нижняя. Как инициировать удаление между ними? Здесь не идёт: [vba]
Dim urar As Range, row1ar As Long, row2ar As Long, NomerStroki As Variant Set urar = ActiveSheet.UsedRange NomerStroki = FindDownCell(urar, "от Заказчика / Owner").Row + 1 '+1,т.к. оставляем строку с "от Заказчика" lRow = Cells.SpecialCells(xlLastCell).Row
[/vba] Получил два номера строк: NomerStroki - верхняя и lRow - нижняя. Как инициировать удаление между ними? Здесь не идёт: [vba]
Спасибо. Работает. Первый раз удаляет как нужно, но при повторном проигрывании, т.е. когда первый и последний номер строки совпадают, то удаляет и строки содержащие "от Заказчика" (обоих "от Заказчиков" удаляет). [vba]
Код
lRow = Cells.SpecialCells(xlLastCell).Row+1
[/vba] добавил +1 и ура!!! Крутяк. Спасибо всем огромное!
Спасибо. Работает. Первый раз удаляет как нужно, но при повторном проигрывании, т.е. когда первый и последний номер строки совпадают, то удаляет и строки содержащие "от Заказчика" (обоих "от Заказчиков" удаляет). [vba]
Код
lRow = Cells.SpecialCells(xlLastCell).Row+1
[/vba] добавил +1 и ура!!! Крутяк. Спасибо всем огромное!timo64uk
r1_ = Cells(1).SpecialCells(xlLastCell).Row ' номер нижней строки ar_ = Cells(1, 3).Resize(r1_).Value 'изменить размеры диапазона "1, 3" от ячейки "1, 3" до r1_ строк и r1_ столбцов t_ = "от Заказчика / Owner" For i = r1_ To 1 Step -1 'номер строки, который перебираем от нижней заполненной вверх If ar_(i, 1) = t_ Then fl_ = 1 ' событие если нашлось искомое Cells(i + 1, 1).Resize(r1_ - i + 1).EntireRow.Select Exit For End If Next i 'перебираем строки от нижней заполненной вверх If fl_ <> 1 Then MsgBox "Текст ''" & t_ & "'' не найден." End If
[/vba] Попытался разобраться в коде, подскажите, пожалуйста, верно ли понял ход выполнения вычислений?
r1_ = Cells(1).SpecialCells(xlLastCell).Row ' номер нижней строки ar_ = Cells(1, 3).Resize(r1_).Value 'изменить размеры диапазона "1, 3" от ячейки "1, 3" до r1_ строк и r1_ столбцов t_ = "от Заказчика / Owner" For i = r1_ To 1 Step -1 'номер строки, который перебираем от нижней заполненной вверх If ar_(i, 1) = t_ Then fl_ = 1 ' событие если нашлось искомое Cells(i + 1, 1).Resize(r1_ - i + 1).EntireRow.Select Exit For End If Next i 'перебираем строки от нижней заполненной вверх If fl_ <> 1 Then MsgBox "Текст ''" & t_ & "'' не найден." End If
[/vba] Попытался разобраться в коде, подскажите, пожалуйста, верно ли понял ход выполнения вычислений?timo64uk
1. "номер нижней строки" - не всегда, но как минимум. Почитайте справку. SpecialCells(xlLastCell) - последняя ячейка в используемом диапазоне. Эквивалентно нажатию Контрл+Енд. Чаще всего да, это последняя заполненная ячейка в таблице, но может быть и ниже. Но последнюю ячейку таблица точно захватит
2. "'изменить размеры диапазона "1, 3" от ячейки "1, 3" до r1_ строк и r1_ столбцов" - Нет. ar_ = Cells(1, 3).Resize(r1_).Value - создаем массив ar_, начиная от ячейки С1 и вниз на r1_ строк
3. "номер строки, который перебираем от нижней заполненной вверх" - почти так. Не номер строки, а вообще номера циклом от r1_ до 1
[vba]
Код
Sub tt() r1_ = Cells(1).SpecialCells(xlLastCell).Row 'номер последней используемой строки ar_ = Cells(1, 3).Resize(r1_).Value 'в массив все от С1 вниз на r1_ t_ = "от Заказчика / Owner" 'текст для поиска For i = r1_ To 1 Step -1 'цикл от r1_ до 1 If ar_(i, 1) = t_ Then 'если элемент массива с номером i равен тексту для поиска fl_ = 1 'флаг равен 1 Cells(i + 1, 1).Resize(r1_ - i + 1).EntireRow.Delete 'от ячейки столбца 1 строки i+1 вниз на r1_ - i + 1. Стираем эти строки Exit For 'Заканчиваем цикл End If ' окончание if Next i 'окончание цикла If fl_ <> 1 Then 'если флаг не =1 (мы не нашли искомый текст) MsgBox "Текст ''" & t_ & "'' не найден." 'выводим об этом сообщение End If ' End Sub
[/vba]
1. "номер нижней строки" - не всегда, но как минимум. Почитайте справку. SpecialCells(xlLastCell) - последняя ячейка в используемом диапазоне. Эквивалентно нажатию Контрл+Енд. Чаще всего да, это последняя заполненная ячейка в таблице, но может быть и ниже. Но последнюю ячейку таблица точно захватит
2. "'изменить размеры диапазона "1, 3" от ячейки "1, 3" до r1_ строк и r1_ столбцов" - Нет. ar_ = Cells(1, 3).Resize(r1_).Value - создаем массив ar_, начиная от ячейки С1 и вниз на r1_ строк
3. "номер строки, который перебираем от нижней заполненной вверх" - почти так. Не номер строки, а вообще номера циклом от r1_ до 1
[vba]
Код
Sub tt() r1_ = Cells(1).SpecialCells(xlLastCell).Row 'номер последней используемой строки ar_ = Cells(1, 3).Resize(r1_).Value 'в массив все от С1 вниз на r1_ t_ = "от Заказчика / Owner" 'текст для поиска For i = r1_ To 1 Step -1 'цикл от r1_ до 1 If ar_(i, 1) = t_ Then 'если элемент массива с номером i равен тексту для поиска fl_ = 1 'флаг равен 1 Cells(i + 1, 1).Resize(r1_ - i + 1).EntireRow.Delete 'от ячейки столбца 1 строки i+1 вниз на r1_ - i + 1. Стираем эти строки Exit For 'Заканчиваем цикл End If ' окончание if Next i 'окончание цикла If fl_ <> 1 Then 'если флаг не =1 (мы не нашли искомый текст) MsgBox "Текст ''" & t_ & "'' не найден." 'выводим об этом сообщение End If ' End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
