Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
помогите изменить маленький макрос, как сделать так что бы "Итого артикул" искал по всему листу а не только в 16 колонне?
 
Добрый День имею данный макрос

Set Sheet = ActiveSheet ' объект Sheet - это обрабатываемый лист Excel
For Each Row In Sheet.UsedRange.Rows
If Row.Cells(16) Like "Итого артикул" Then Row.Delete
Next

как сделать так что бы "Итого артикул" искал по всему листу а не только в 16 колонне?

спасибо
 
Код
    Dim rFndRng As Range, rR As Range
    For Each rR In ActiveSheet.UsedRange.Rows
        Set rFndRng = rR.Find("Итого артикул", , xlValues, xlWhole)
        If Not rFndRng Is Nothing Then rR.Delete
    Next

Если хотите, чтобы "Итого артикул" просматривалось как часть содержимого ячейки, вставьте симолы подстановки: "*Итого артикул*"
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Код
Sub DeleteArtikul()

    Dim i As Long
    Dim cell As Range
    Dim sh As Worksheet
    Dim col As New Collection
    Dim firstAddress As String, addr As String
    
    With ActiveSheet
        With .UsedRange
            Set cell = .Find(What:="Итого артикул")
            If Not cell Is Nothing Then
                firstAddress = cell.Address
                Do
                    col.Add cell.Address
                    Set cell = .FindNext(cell)
                Loop While Not cell Is Nothing And cell.Address <> firstAddress
            End If
        End With
        For i = 1 To col.Count
            If i = col.Count Then addr = addr & col(i) Else addr = addr & col(i) & ","
        Next
        .Range(addr).EntireRow.Delete
    End With
    
End Sub
Изменено: Johny - 4 Янв 2013 12:01:45
There is no knowledge that is not power
 
При цикле For Each одна из двух соседних строк останется.
 
спасибо то что нужно а еще не подскажите как например добавить еще "Итого артикул" + "Печать" + "Склад" итд?
 
Цитата
The_Prist пишет:
Код
     Dim rFndRng As Range, rR As Range
    For Each rR In ActiveSheet.UsedRange.Rows
        Set rFndRng = rR.Find("Итого артикул", , xlValues, xlWhole)
        If Not rFndRng Is Nothing Then rR.Delete
    Next 

Если хотите, чтобы "Итого артикул" просматривалось как часть содержимого ячейки, вставьте симолы подстановки: "*Итого артикул*"

это решение больше думаю походит к моей задаче и самому как то более понятно НО как еще добавить другие параметры как "Итого артикул" + "Печать" + "Склад" итд
 
Давайте чуть изменим для большей корректности(раз уж сам принцип Вам понятен теперь):
Код
Sub Del_Rows()
    Dim rFndRng As Range, lr As Long, asFnd, li As Long
    asFnd = Array("Итого артикул", "Печать", "Склад")
    'отключаем обновление экрана - для ускорения выполнения
    Application.ScreenUpdating = 0
    For lr = ActiveSheet.UsedRange.Rows + ActiveSheet.UsedRange.Row - 1 To 1 Step -1
        For li = LBound(asFnd) To UBound(asFnd)
            Set rFndRng = Rows(lr).Find(asFnd(li), , xlValues, xlWhole)
            If Not rFndRng Is Nothing Then rR.Delete: Exit For
        Next li
    Next lr
    'возвращаем обновление экрана
    Application.ScreenUpdating = 1
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
выдает ошибку 13 на строке
For lr = ActiveSheet.UsedRange.Rows + ActiveSheet.UsedRange.Row - 1 To 1 Step -1


Цитата
The_Prist пишет:
Давайте чуть изменим для большей корректности(раз уж сам принцип Вам понятен теперь):
Код
 Sub Del_Rows()
    Dim rFndRng As Range, lr As Long, asFnd, li As Long
    asFnd = Array("Итого артикул", "Печать", "Склад")
    'отключаем обновление экрана - для ускорения выполнения
    Application.ScreenUpdating = 0
    For lr = ActiveSheet.UsedRange.Rows + ActiveSheet.UsedRange.Row - 1 To 1 Step -1
        For li = LBound(asFnd) To UBound(asFnd)
            Set rFndRng = Rows(lr).Find(asFnd(li), , xlValues, xlWhole)
            If Not rFndRng Is Nothing Then rR.Delete: Exit For
        Next li
    Next lr
    'возвращаем обновление экрана
    Application.ScreenUpdating = 1
End Sub 
 
Ну да. Писал сразу в форум - не проверял. Забыл чуть-чуть:
Код
For lr = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row - 1 To 1 Step -1

Другую еще ошибку нашел. Надо заменить rR.Delete, на Rows(lr).Delete.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
а можете полностью выложить откорректированный а то я чуть чуть запутался  :D ?
заранее благодарен
 
Где тут можно было запутаться?
Код
Sub Del_Rows()
    Dim rFndRng As Range, lr As Long, asFnd, li As Long
    asFnd = Array("Итого артикул", "Печать", "Склад")
    'отключаем обновление экрана - для ускорения выполнения
    Application.ScreenUpdating = 0
    For lr = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row - 1 To 1 Step -1
        For li = LBound(asFnd) To UBound(asFnd)
            Set rFndRng = Rows(lr).Find(asFnd(li), , xlValues, xlWhole)
            If Not rFndRng Is Nothing Then Rows(lr).Delete: Exit For
        Next li
    Next lr
    'возвращаем обновление экрана
    Application.ScreenUpdating = 1
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
ОГРОМНОЕ СПАСИБО  :D
все работает как часы
 
в яндекс деньги перевел :)
спасибо за подсказки
Страницы: 1
Читают тему (гостей: 1)