Удаление строки по значению

[FormAlDeGid]

EducatedFool все прелестно работает =) мая рада =)

нет предела совершенству посему пойду дальше и спрошу еще.

в верхней строке все того же сводного файле в столбце "J" имеется слово "Итого" из за чего строка удаляется, а это не желательно как этого избежать? Может предварительно изменить тест в этой ячейке?

и еще...
при форматировании листа мой макрос добавляет два столбца с формулами в первом идет обработка данных строки, второй округляет полученный результат, в итоге в пустых строках появляется надпись "#ДЕЛ/0!" говорит мол на ноль делить нельзя. я конечно с ним согласен, но вот вопрос как сделать чтобы формулы присваивались только к заполненным строкам или может просто очистить все пустые строки? у меня распространение формул идет до 150 строки.

просто для сведения: макрос делал не руками, а приславутой кнопочкой записать макрос, а теперь по кусочку добавляю необходимые части кода.

[EducatedFool]

в верхней строке все того же сводного файле в столбце "J" имеется слово "Итого" из за чего строка удаляется, а это не желательно как этого избежать?

Я же написал Вам макрос:

Sub УдалениеИтоговыхСтрок()
    On Error Resume Next: Application.ScreenUpdating = False
    While Err = 0
        Range("f:f").Find("Итого").EntireRow.Delete
    Wend
End Sub

Этот код НИКАК НЕ МОЖЕТ удалить слово в столбце "J".
Или Вы не проверяете мой код?

Даже если Вы умудрились переделать макрос настолько, что удаляются ВСЕ слова Итого в книге, ничто Вам не мешает заменить в указанном слове (которое в первой строке) русские символы "о" на аналогичные латинские.
Визуально разница заметна не будет, а макрос такое слово пропустит.

мой макрос добавляет два столбца с формулами

Может, покажете, наконец, свой макрос?

Есть несколько вариантов решения.
Неохота расписывать все способы - проще переделать готовый код.

[FormAlDeGid]

магистр EducatedFool приношу свои извинения за мою глупость. при копировании кода с сайта вместо "итого" вписалось "?????" посему работало оно не корректно (удивительно что вообще работало). но после исправления Ваш макрос заработал как часики от CASIO =)


вот так выглядит мой ужас =)

Sub Сводная_Next()
'
' Сводная_Next Макрос
'

'
On Error Resume Next: Application.ScreenUpdating = False
While Err = 0
Range("f:f").Find("итого").EntireRo w.Delete
Wend
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").ColumnWidth = 1.29
Columns("K:K").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("L:L").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("K2").Select
ActiveCell.FormulaR1C1 = "=(RC[-6]+(RC[-2]/RC[-5]))*1.3"
Range("L2").Select
ActiveCell.FormulaR1C1 = "=ROUND(RC[-1],-1)"
Range("K2:L2").Select
Selection.AutoFill Destination:=Range("K2:L149"), Type:=xlFillDefault
Range("K2:L149").Select
ActiveWindow.ScrollRow = 123
ActiveWindow.ScrollRow = 122
ActiveWindow.ScrollRow = 121
ActiveWindow.ScrollRow = 120
ActiveWindow.ScrollRow = 119
ActiveWindow.ScrollRow = 118
ActiveWindow.ScrollRow = 116
ActiveWindow.ScrollRow = 114
ActiveWindow.ScrollRow = 112
ActiveWindow.ScrollRow = 108
ActiveWindow.ScrollRow = 105
ActiveWindow.ScrollRow = 102
ActiveWindow.ScrollRow = 98
ActiveWindow.ScrollRow = 96
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 88
ActiveWindow.ScrollRow = 85
ActiveWindow.ScrollRow = 81
ActiveWindow.ScrollRow = 77
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 60
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 51
ActiveWindow.ScrollRow = 49
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Columns("G:K").Select
Range("K1").Activate
Selection.EntireColumn.Hidden = True
Columns("E:E").Select
Selection.EntireColumn.Hidden = True
Columns("M:M").Select
Selection.AutoFilter
Columns("C:C").ColumnWidth = 44
ActiveWindow.SmallScroll Down:=8
ActiveSheet.UsedRange.Columns(1).Sp ecialCells(xlCellTypeBlanks).Offset (, 12).Formula = "ё"
End Sub

[EducatedFool]

Немного сократил и оптимизировал код:

Sub Сводная_Next()
    On Error Resume Next: Application.ScreenUpdating = False
    While Err = 0
        Range("f:f").Find("итого").EntireRow.Delete
    Wend
    Columns(1).AutoFit
    Columns(2).ColumnWidth = 1.29: Columns(3).ColumnWidth = 44
    Columns("K:L").Insert

    Dim ra As Range: Set ra = Intersect(Range("2:" & Rows.Count), _
                                        ActiveSheet.UsedRange.Columns(1).SpecialCells(2))

    ra.Offset(, 10).FormulaR1C1 = "=(RC[-6]+(RC[-2]/RC[-5]))*1.3"
    ra.Offset(, 11).FormulaR1C1 = "=ROUND(RC[-1],-1)"
    ra.Offset(, 2).WrapText = True ' перенос по словам в 3-м столбце
    
    Range("G:K,E:E").EntireColumn.Hidden = True
    Columns("M:M").AutoFilter
    ActiveSheet.UsedRange.Columns(1).SpecialCells(xlCellTypeBlanks).Offset(, 12).Formula = "ё"
    Application.ScreenUpdating = True
End Sub

Проверяйте.

[SAS888]

надо чтобы пустые строки-разделители остались.

Ну, так добавьте такую проверку в предложенный код. Например, так:

Sub DelRows()
    Dim i As Long: Application.ScreenUpdating = False
    For i = Cells(Rows.Count, 6).End(xlUp).Row To 1 Step -1
        If Cells(i, 1) = "" Then If Rows(i).Text = "" Then Else Rows(i).Delete
    Next
End Sub

[FormAlDeGid]

EducatedFool код работает превосходно

___________________________________
каждый юнлиг хочет стать магистром =)
да прибудет с Тобой Сила