Страницы: 1
RSS
Удаление строк макросом.
 
Подробное описание в примере
 
Sub del_()  
   Dim cc As Range, r As Range, flag As Boolean  
   With Sheets(1)  
       For Each cc In Intersect(.UsedRange, .Range("D:D"))  
           If InStr(cc.Offset(, 1).Value, "обратно") Then  
               flag = True  
               Set r = cc.Offset(2)  
           End If  
           If flag Then  
               If cc.Value = "Масса наплавленного металла (1%), кг" Then  
                   Set r = Range(r, cc)  
                   r.Select  
                   flag = False  
               End If  
           End If  
       Next  
   End With  
End Sub  
 
 
Про сумму не понял - какую сумму?
 
Забыл заменить  
r.Select  
на  
r.EntireRow.Delete  
:)  
Ну не суть... :)  
 
А сумма ведь там уже считается... Что ещё нужно? Будет расширяться диапазон - увеличится сумма.  
Хотя можно при этом переборе и сумму параллельно посчитать.
 
Hugo спс за ответ.  
Хотел прицепить твой макрос к своему записанному макрорекордером но не получилось. Прицепил пример как есть и как должно получиться. Моих попыток в файле нет, т.к. они на работе остались.  
Это всего лишь кусок таблицы, марка(например Г57) может состоять из разного к-ва строк и разного названия, в любом месте таблицы.
 
Sub xxx()  
 Dim c As Range, i&  
 If ActiveCell.Column <> 4 Then Exit Sub  
 If ActiveCell.Value <> 1 Then Exit Sub  
 i = ActiveCell.Row + 1  
 With ActiveSheet  
   Do Until .Cells(i, 4) = "Масса наплавленного металла (1%), кг": i = i + 1: Loop  
   .Cells(i, 4).EntireRow.Delete  
   .Range(ActiveCell.Offset(1, 0), .Cells(i - 2, 4)).EntireRow.Delete  
   ActiveCell.Offset(0, 9).Formula = ActiveCell.Offset(-1, 10).MergeArea.Cells(1, 1).Formula  
   ActiveCell.Resize(1, 9).ClearContents  
   ActiveCell.Offset(0, 11).Resize(1, 4).ClearContents  
   ActiveCell.Offset(0, 1).Value = "обратно " & ActiveCell.Offset(-1, -1).MergeArea.Cells(1, 1).Value  
   ActiveCell.Offset(0, 1).Resize(1, 2).Merge  
   ActiveCell.Offset(0, 1).Resize(1, 2).HorizontalAlignment = xlCenter  
 End With  
End Sub
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
файл
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Большое человеческое спасибо!!! То что нужно.
Страницы: 1
Наверх