Доброго дня, уважаемые форумчане! Прошу помощи в составлении макроса для следующей задачи или указанием к решению. Есть таблица с столбцом в котором имеются строчки start, 1, done и start, 0, done. Возможно ли сделать макрос, который будет удалять строчку 0 и находящиеся над ней строчку start и под ней done, не трогая строки рядом со значением 1?
Доброго дня, уважаемые форумчане! Прошу помощи в составлении макроса для следующей задачи или указанием к решению. Есть таблица с столбцом в котором имеются строчки start, 1, done и start, 0, done. Возможно ли сделать макрос, который будет удалять строчку 0 и находящиеся над ней строчку start и под ней done, не трогая строки рядом со значением 1?dartlobrik
Макрос ищет в столбце "B" слово "start", затем смотрит строку, которая ниже, если там 0, то удаляет три строки.
[vba]
Код
Sub Удалить() Dim arr(), lr As Long, i As Long Application.ScreenUpdating = False lr = Cells(Rows.Count, "B").End(xlUp).Row arr() = Range("B1:B" & lr).Value For i = UBound(arr) To 1 Step -1 If arr(i, 1) = "start" Then If arr(i + 1, 1) = 0 Then Rows(i).Resize(3).Delete End If End If Next i Application.ScreenUpdating = True End Sub
[/vba]
Макрос ищет в столбце "B" слово "start", затем смотрит строку, которая ниже, если там 0, то удаляет три строки.
[vba]
Код
Sub Удалить() Dim arr(), lr As Long, i As Long Application.ScreenUpdating = False lr = Cells(Rows.Count, "B").End(xlUp).Row arr() = Range("B1:B" & lr).Value For i = UBound(arr) To 1 Step -1 If arr(i, 1) = "start" Then If arr(i + 1, 1) = 0 Then Rows(i).Resize(3).Delete End If End If Next i Application.ScreenUpdating = True End Sub
With Range("A1").CurrentRegion x = .Value ReDim y(1 To UBound(x), 1 To UBound(x, 2)) For i = 2 To UBound(x) Step 3 If x(i, 2) = 1 Then For j = 1 To 3 k = k + 1 y(k, 1) = x(i - 2 + j, 1) y(k, 2) = x(i - 2 + j, 2) y(k, 3) = x(i - 2 + j, 3) Next j End If Next i .ClearContents .Resize(k, 3).Value = y End With End Sub
[/vba]
или, например, так:
[vba]
Код
Sub ertert() Dim x, y(), i&, j&, k&
With Range("A1").CurrentRegion x = .Value ReDim y(1 To UBound(x), 1 To UBound(x, 2)) For i = 2 To UBound(x) Step 3 If x(i, 2) = 1 Then For j = 1 To 3 k = k + 1 y(k, 1) = x(i - 2 + j, 1) y(k, 2) = x(i - 2 + j, 2) y(k, 3) = x(i - 2 + j, 3) Next j End If Next i .ClearContents .Resize(k, 3).Value = y End With End Sub
китин, Вы переменные заключили в кавычки, плюс еще символ "&" тоже заключили в кавычки. Все, что заключается в кавычки, воспринимается текстом. То есть переменная "i" превратилась просто в букву "i", символ "&" превратился просто в символ "&". [vba]
Код
Rows(i - 1 & ":" & i + 1).Delete
[/vba]
китин, Вы переменные заключили в кавычки, плюс еще символ "&" тоже заключили в кавычки. Все, что заключается в кавычки, воспринимается текстом. То есть переменная "i" превратилась просто в букву "i", символ "&" превратился просто в символ "&". [vba]
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
