Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

Удалить строку по условию

86K
15 октября 2014 года
igenex
9 / / 15.10.2014
Подскажите какой нить макрос для того, чтобы удалить строки в которых, отсутсвует хоть одна ячейка определенного цвета
275
16 октября 2014 года
pashulka
985 / / 19.09.2004
igenex, Если оставить в покое генераторы (строка #3), но обратить внимание на остальные критерии условного форматирования, то получается, что строка подлежит удалению, только если цена в столбце "F" будет меньше или равна 0 (см.листинг1) и/или же товар имеется у всех поставщиков/конкурентов, причём у всех он должен быть дороже (см.листинг2)

Код:
Private Sub DeleteRowsToCriteriaPrice() 'Microsoft Excel 95(или старше)
    Application.ScreenUpdating = False

    Dim iCount&, iColumn&, iRow&, iCriteria#
    iCount = ActiveSheet.UsedRange.Columns.Count

    For iRow = [A1].SpecialCells(xlLastCell).Row To 4 Step -1
        iCriteria = Cells(iRow, 6) 'Cells(iRow, "F").Value
        If iCriteria > 0 Then
           For iColumn = 7 To iCount 'UsedRange.Columns.Count
               If Cells(iRow, iColumn) >= iCriteria _
               Then Cells(iRow, iColumn).ClearContents
           Next
        Else
           Rows(iRow).Delete
        End If
    Next

    Application.ScreenUpdating = True
End Sub
Код:
Private Sub DeleteRowsToCriteriaPrice2() 'Microsoft Excel 95(или старше)
    Application.ScreenUpdating = False

    Dim iCount&, iColumn&, iRow&, iCriteria#, flagDel As Boolean
    iCount = ActiveSheet.UsedRange.Columns.Count: flagDel = True

    For iRow = [A1].SpecialCells(xlLastCell).Row To 4 Step -1
        iCriteria = Cells(iRow, 6) 'Cells(iRow, "F").Value
        For iColumn = 7 To iCount 'UsedRange.Columns.Count
            If Cells(iRow, iColumn) >= iCriteria Then
               Cells(iRow, iColumn).ClearContents
            Else
               flagDel = False
            End If
        Next
        If flagDel = True Then
           Rows(iRow).Delete
        Else
           flagDel = True
        End If
    Next

    Application.ScreenUpdating = True
End Sub
P.S. При ответе, цитировать всё предыдущее сообщение, вовсе не нужно :)
275
16 октября 2014 года
pashulka
985 / / 19.09.2004
Сие можно осуществить, например, так :

 
Код:
'…
For iColumn = iCount To 7 Step -1
    If Application.Count(Columns(iColumn)) = 0 Then Columns(iColumn).Delete
Next

Application.ScreenUpdating = True
P.S. Если реальный сводный прайс содержит намного больше строк, чем образец на форуме, то возможно имеет смысл перебирать не ячейки, а элементы массива …
275
15 октября 2014 года
pashulka
985 / / 19.09.2004
Если Вы используете Microsoft Excel XP (или старше), то для удаления строк (в активном рабочем листе), где нет ячеек с жёлтой заливкой, можно использовать нижеопубликованный макрос.

Разумеется, цвет заливки указан только в качестве примера.

Код:
Private Sub DeleteRowsToNotColor() 'Microsoft Excel XP(или старше)
    With Application
         .FindFormat.Interior.Color = vbYellow 'Жёлтый цвет заливки
         'Также допускается использование свойства ColorIndex
         .ScreenUpdating = False
         Dim iRow&, iSource As Range
         For iRow = .[A1].SpecialCells(xlLastCell).Row To 1 Step -1
             Set iSource = .Rows(iRow)
             If iSource.Find("", SearchFormat:=True) Is Nothing Then
                iSource.Delete
             End If
         Next
         .ScreenUpdating = True
    End With
End Sub
86K
16 октября 2014 года
igenex
9 / / 15.10.2014
Цитата: pashulka
Если Вы используете Microsoft Excel XP (или старше), то для удаления строк (в активном рабочем листе), где нет ячеек с жёлтой заливкой, можно использовать нижеопубликованный макрос.

Разумеется, цвет заливки указан только в качестве примера.

Код:
Private Sub DeleteRowsToNotColor() 'Microsoft Excel XP(или старше)
    With Application
         .FindFormat.Interior.Color = vbYellow 'Жёлтый цвет заливки
         'Также допускается использование свойства ColorIndex
         .ScreenUpdating = False
         Dim iRow&, iSource As Range
         For iRow = .[A1].SpecialCells(xlLastCell).Row To 1 Step -1
             Set iSource = .Rows(iRow)
             If iSource.Find("", SearchFormat:=True) Is Nothing Then
                iSource.Delete
             End If
         Next
         .ScreenUpdating = True
    End With
End Sub


Здравствуйте, спасибо. Макрос работает, но не лично в моем случае. Я забыл упомянуть, что заливка происходит за счет условного форматирования. Но такие ячейки ваш макрос не видит (. Можете что нибудь посоветовать в этом случае? Прикрепил свой файлик. Заранее спасибо.

Прикрепленные файлы:
42 Кб
Загрузок: 519
86K
16 октября 2014 года
igenex
9 / / 15.10.2014
А вообще в идеале, чтобы макрос сначала прошелся по столбцам от столбца G и до конца, удаляя цены без заливки. А потом прошелся по строкам, удаляя строки, в которых нет хоть одной ячейки с заливкой.
86K
16 октября 2014 года
igenex
9 / / 15.10.2014
Всё круто. Спасибо. + 100 к Вашей карме )
86K
16 октября 2014 года
igenex
9 / / 15.10.2014
И последняя просьба ). Если б еще в конце, конечным штрихом, макрос проверял таблицу на столбцы без цен и удалял их - это была бы вообще песня )
86K
16 октября 2014 года
igenex
9 / / 15.10.2014
Цитата: pashulka
Сие можно осуществить, например, так :



P.S. Если реальный сводный прайс содержит намного больше строк, чем образец на форуме, то возможно имеет смысл перебирать не ячейки, а элементы массива …



Нет. это и есть весь файлик.
Цены Вам нету. Спасибо огромное )

Знаете кого-то, кто может ответить? Поделитесь с ним ссылкой.

Ваш ответ

Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог