[offtop]Скажите пожалуйста, для чего в разделе по формулам (макросы в разделе Вопросы по VBA) информация, что вы ищите макрос???[/offtop] [moder]Действительно! Перенесла тему[/moder]
[offtop]Скажите пожалуйста, для чего в разделе по формулам (макросы в разделе Вопросы по VBA) информация, что вы ищите макрос???[/offtop] [moder]Действительно! Перенесла тему[/moder]AlexM
Номер мобильного модема (без голосовой связи) 9269171249 МегаФон, Московский регион.
Сообщение отредактировал Pelena - Среда, 01.03.2017, 22:58
Sub YellowDead() On Error GoTo ОШ Application.ScreenUpdating = False Dim LC, LR, F, K, str, strcl, koef Set strcl = New Collection LR = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 LC = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1 For K = 1 To LR For F = 1 To LC If ActiveSheet.Cells(K - koef, F).Interior.Color = 65535 Then: ActiveSheet.Rows(K - koef).Delete: koef = koef + 1: strcl.Add K: Exit For Next F Next K If strcl.Count > 0 Then For F = 1 To strcl.Count str = str & ": " & strcl(F) Next F str = "Удалены строки: - " & Chr$(13) & str MsgBox str, vbOKOnly, "Выполнено!" Else str = "строки с ячейками желтого цвета(65536) ненайдены!" MsgBox str, vbOKOnly, "Выполнено!" End If ОШ: Application.ScreenUpdating = True End Sub
[/vba] так удаляем если есть желтые(оттенок 65535) отчет показывает какие номера строк удалены а если условие заменить: [vba]
Код
If ActiveSheet.Cells(K - koef, F).Interior.Color = 65535 Or ActiveSheet.Rows.RowHeight = 0 Then: ActiveSheet.Rows(K - koef).Delete: koef = koef + 1: strcl.Add K: Exit For
[/vba] то с нулевой высотой строки тоже удаляет
[vba]
Код
Sub YellowDead() On Error GoTo ОШ Application.ScreenUpdating = False Dim LC, LR, F, K, str, strcl, koef Set strcl = New Collection LR = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 LC = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1 For K = 1 To LR For F = 1 To LC If ActiveSheet.Cells(K - koef, F).Interior.Color = 65535 Then: ActiveSheet.Rows(K - koef).Delete: koef = koef + 1: strcl.Add K: Exit For Next F Next K If strcl.Count > 0 Then For F = 1 To strcl.Count str = str & ": " & strcl(F) Next F str = "Удалены строки: - " & Chr$(13) & str MsgBox str, vbOKOnly, "Выполнено!" Else str = "строки с ячейками желтого цвета(65536) ненайдены!" MsgBox str, vbOKOnly, "Выполнено!" End If ОШ: Application.ScreenUpdating = True End Sub
[/vba] так удаляем если есть желтые(оттенок 65535) отчет показывает какие номера строк удалены а если условие заменить: [vba]
Код
If ActiveSheet.Cells(K - koef, F).Interior.Color = 65535 Or ActiveSheet.Rows.RowHeight = 0 Then: ActiveSheet.Rows(K - koef).Delete: koef = koef + 1: strcl.Add K: Exit For
[/vba] то с нулевой высотой строки тоже удаляетK-SerJC