Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Нужно модернизировать макрос
 
#1
25.07.2011 10:36:21
Есть такой макрос, который удаляет строки по найденному значению:  
Sub УдалениеСтрокПоУсловию()  
   Dim ra As Range, delra As Range  
   Application.ScreenUpdating = False    ' отключаем обновление экрана  
 
   ТекстДля Поиска = "Local"    ' удаляем строки с таким текстом  
 
   ' перебираем все строки в используемом диапозоне листа  
   For Each ra In ActiveSheet.UsedRange.Rows  
       ' если в строке найден искомый текст  
       If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then  
           ' добавляем строку в дапозон для удаления  
           If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)  
       End If  
   Next  
   ' если подходящие строки найдены - удаляем их  
   If Not delra Is Nothing Then delra.EntireRow.Delete  
End Sub  
 
Нужно модернизировать данный макрос, чтобы после поиска и удаления строк по условию, он также удалял 1 строку сверху от найденного.
 
 
 
#2
25.07.2011 10:54:25
Сверху от найденного - это как?  
 
К примеру, макрос нашел текст "Local" в строках 8, 14, 22, 23  
Надо удалить строку номер 7?  
Или строки 7, 13, 21?
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#3
25.07.2011 11:01:28
{quote}{login=EducatedFool}{date=25.07.2011 10:54}{thema=}{post}Сверху от найденного - это как?  
 
К примеру, макрос нашел текст "Local" в строках 8, 14, 22, 23  
Надо удалить строку номер 7?  
Или строки 7, 13, 21?{/post}{/quote}  
 
Надо удалить строки 7, 13, 21 и т.д.
 
 
 
#4
25.07.2011 12:07:29
Sub УдалениеСтрокПоУсловию()  
   Dim ra As Range, delra As Range  
   Application.ScreenUpdating = False    ' отключаем обновление экрана  
 
   ТекстДляПоиска = "Наименование ценности"    ' удаляем строки с таким текстом  
 
   ' перебираем все строки в используемом диапазоне листа  
   For Each ra In ActiveSheet.UsedRange.Rows  
       ' если в строке найден искомый текст  
       If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then  
           ' добавляем строку в диапазон для удаления  
           If delra Is Nothing Then  
               Set delra = Union(ra, ra.Offset(-1))  
           Else  
               Set delra = Union(delra, ra, ra.Offset(-1))  
           End If  
       End If  
   Next  
   ' если подходящие строки найдены - удаляем их  
   If Not delra Is Nothing Then delra.EntireRow.Delete  
End Sub
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#5
25.07.2011 12:29:35
Сделал через адреса ячеек  
 
Sub delll()  
Dim ra As Range, delra As Range  
 
Application.ScreenUpdating = False  
 
tex = "local"' искомый текст  
 
For Each ra In ActiveSheet.UsedRange.Rows  
x = ra.Address 'запоминаем адрес ячейки ($A$1) - нам надо узнать адрес без $  
y = Right(x, Len(x) - 1)'избавились от первого $    
z = Left(y, InStr(y, "$") - 1) 'имя столбца  
w = Right(y, InStrRev(y, "$") - 1) 'номер строки  
If w > 1 Then  
   'если искомое значение не в первой ячейке то узнаем адрес ячейки на 1 выше  
   rad = ActiveSheet.Range("$" & z & "$" & w - 1 & "").Address  
Else  
   rad = ra.Address ' если первая ячейка  
End If  
 
If Not ra.Find(tex, , xlValues, xlPart) Is Nothing Then  
 
   If delra Is Nothing Then  
        'присваиваем наш новый диапазон  
       Set delra = ActiveSheet.Range("" & rad & ":" & ra.Address & "")  
   Else  
       Set delra = Union(delra, ActiveSheet.Range("" & rad & ":" & ra.Address & ""))  
   End If  
End If  
Next  
 
If Not delra Is Nothing Then delra.EntireRow.Delete  
End Sub
 
 
 
#6
25.07.2011 12:42:43
Рабочий вариант:  
 
Sub УдалениеСтрокПоУсловию()  
Dim ra As Range, delra As Range  
Application.ScreenUpdating = False ' отключаем обновление экрана  
 
ТекстДляПоиска = "Reject" ' удаляем строки с таким текстом  
 
' перебираем все строки в используемом диапозоне листа  
For Each ra In ActiveSheet.UsedRange.Rows  
' если в строке найден искомый текст  
If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then  
' добавляем строку в диапозон для удаления  
If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra, ra.Offset(-1))  
End If  
Next  
' если подходящие строки найдены - удаляем их  
If Not delra Is Nothing Then delra.EntireRow.Delete  
End Sub
 
 
 
#7
25.07.2011 12:44:39
Всем спасибо, тема закрыта.
 
 
 
Страницы: 1
Читают тему
Наверх