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
Удалить строку по условию
Подскажите какой нить макрос для того, чтобы удалить строки в которых, отсутсвует хоть одна ячейка определенного цвета
igenex, Если оставить в покое генераторы (строка #3), но обратить внимание на остальные критерии условного форматирования, то получается, что строка подлежит удалению, только если цена в столбце "F" будет меньше или равна 0 (см.листинг1) и/или же товар имеется у всех поставщиков/конкурентов, причём у всех он должен быть дороже (см.листинг2)
P.S. При ответе, цитировать всё предыдущее сообщение, вовсе не нужно :)
Код:
Код:
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
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. Если реальный сводный прайс содержит намного больше строк, чем образец на форуме, то возможно имеет смысл перебирать не ячейки, а элементы массива …
Код:
'…
For iColumn = iCount To 7 Step -1
If Application.Count(Columns(iColumn)) = 0 Then Columns(iColumn).Delete
Next
Application.ScreenUpdating = True
For iColumn = iCount To 7 Step -1
If Application.Count(Columns(iColumn)) = 0 Then Columns(iColumn).Delete
Next
Application.ScreenUpdating = True
Если Вы используете 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
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
Цитата: 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
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
Здравствуйте, спасибо. Макрос работает, но не лично в моем случае. Я забыл упомянуть, что заливка происходит за счет условного форматирования. Но такие ячейки ваш макрос не видит (. Можете что нибудь посоветовать в этом случае? Прикрепил свой файлик. Заранее спасибо.
А вообще в идеале, чтобы макрос сначала прошелся по столбцам от столбца G и до конца, удаляя цены без заливки. А потом прошелся по строкам, удаляя строки, в которых нет хоть одной ячейки с заливкой.
Всё круто. Спасибо. + 100 к Вашей карме )
И последняя просьба ). Если б еще в конце, конечным штрихом, макрос проверял таблицу на столбцы без цен и удалял их - это была бы вообще песня )
Цитата: pashulka
Сие можно осуществить, например, так :
P.S. Если реальный сводный прайс содержит намного больше строк, чем образец на форуме, то возможно имеет смысл перебирать не ячейки, а элементы массива …
P.S. Если реальный сводный прайс содержит намного больше строк, чем образец на форуме, то возможно имеет смысл перебирать не ячейки, а элементы массива …
Нет. это и есть весь файлик.
Цены Вам нету. Спасибо огромное )