Прошу помощи по макросу

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Прошу помощи по макросу (Формулы)

Андрей М

Дата: Понедельник, 27.01.2014, 22:24 | Сообщение № 1

Группа: Гости

Имеется рабочая таблица в которой это макрос удаляет строки по одной. В таблице в столбце А перечислены:
Участок, Агрегат, Механизм, Узел, Деталь, Субдеталь1, Субдеталь2, Субдеталь3.
Требуется чтобы нижеприведенный макрос позволял удалять строки из следующих требований:
1 если удаляется строка "Участок", то удаляются вместе с ней и все следующие строки;
2 если удаляется строка "Агрегат", то удаляются вместе с ней и все следующие строки, а строка "Участок" остается;
3 если удаляется строка "Механизм", то удаляются вместе с ней и все следующие строки, а строки "Участок" и "Агрегат" остаются;
4 и так далее.
Файл срочно требуется для работы, а навыков программирования нет напрочь. Помогите моему горю, пожалуйста.
С уважением, Андрей

Sub udalit_ctroku()
' del
Dim z
Dim y
Dim Сообщение As Variant
z = ActiveCell.Address
y = Range(z).Value
If y = "Участок" Or y = "Агрегат" Or y = "Механизм" Or y = "Узел" Or y = "Деталь" Or y = "Субдеталь1" Or y = "Субдеталь2" Or y = "Субдеталь3" Then
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Сообщение = InputBox("Для подтверждения удаления введите слово 'ДА' строчными или прописными буквами и нажмите кнопку 'ОК'", "УДАЛЕНИЕ СТРОКИ", "ВЫ УВЕРЕНЫ?")
If Сообщение <> "ДА" And Сообщение <> "Да" And Сообщение <> "да" Then
MsgBox "СТРОКА НЕ УДАЛЕНА!", vbCritical, "ОШИБКА УДАЛЕНИЯ"
Exit Sub

End If

Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Sheets("не_трогать").Visible = -1
Sheets("не_трогать").Select
Range("b16:s16").Select
Selection.Copy
Sheets("не_трогать").Visible = 2
GoTo M1
End If
If y <> "Участок" Or y <> "Агрегат" Or y <> "Механизм" Or y <> "Узел" Or y <> "Деталь" Or y <> "Субдеталь1" Or y <> "Субдеталь2" Or y <> "Субдеталь3" Then
MsgBox "Для удаления строки ВЫДЕЛИТЕ ЯЧЕЙКУ 'Участок', 'Арегат', 'Механизм', 'Узел', 'Деталь', 'Субдеталь1', 'Субдеталь2' и т.д.", vbExclamation, "ОШИБКА УДАЛЕНИЯ СТРОКИ"
Exit Sub
End If
M1:
Sheets ("иерархия") .Select
ActiveCell.Offset(-1, 1).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

End Sub
[moder]Тема закрыта из-за многочисленных нарушений Правил форума. Перечислять пункты лениво. Ибо дохренищщща их, нарушенных.

Ответить

СообщениеИмеется рабочая таблица в которой это макрос удаляет строки по одной. В таблице в столбце А перечислены:
Участок, Агрегат, Механизм, Узел, Деталь, Субдеталь1, Субдеталь2, Субдеталь3.
Требуется чтобы нижеприведенный макрос позволял удалять строки из следующих требований:
1 если удаляется строка "Участок", то удаляются вместе с ней и все следующие строки;
2 если удаляется строка "Агрегат", то удаляются вместе с ней и все следующие строки, а строка "Участок" остается;
3 если удаляется строка "Механизм", то удаляются вместе с ней и все следующие строки, а строки "Участок" и "Агрегат" остаются;
4 и так далее.
Файл срочно требуется для работы, а навыков программирования нет напрочь. Помогите моему горю, пожалуйста.
С уважением, Андрей

Sub udalit_ctroku()
' del
Dim z
Dim y
Dim Сообщение As Variant
z = ActiveCell.Address
y = Range(z).Value
If y = "Участок" Or y = "Агрегат" Or y = "Механизм" Or y = "Узел" Or y = "Деталь" Or y = "Субдеталь1" Or y = "Субдеталь2" Or y = "Субдеталь3" Then
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Сообщение = InputBox("Для подтверждения удаления введите слово 'ДА' строчными или прописными буквами и нажмите кнопку 'ОК'", "УДАЛЕНИЕ СТРОКИ", "ВЫ УВЕРЕНЫ?")
If Сообщение <> "ДА" And Сообщение <> "Да" And Сообщение <> "да" Then
MsgBox "СТРОКА НЕ УДАЛЕНА!", vbCritical, "ОШИБКА УДАЛЕНИЯ"
Exit Sub

End If

Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Sheets("не_трогать").Visible = -1
Sheets("не_трогать").Select
Range("b16:s16").Select
Selection.Copy
Sheets("не_трогать").Visible = 2
GoTo M1
End If
If y <> "Участок" Or y <> "Агрегат" Or y <> "Механизм" Or y <> "Узел" Or y <> "Деталь" Or y <> "Субдеталь1" Or y <> "Субдеталь2" Or y <> "Субдеталь3" Then
MsgBox "Для удаления строки ВЫДЕЛИТЕ ЯЧЕЙКУ 'Участок', 'Арегат', 'Механизм', 'Узел', 'Деталь', 'Субдеталь1', 'Субдеталь2' и т.д.", vbExclamation, "ОШИБКА УДАЛЕНИЯ СТРОКИ"
Exit Sub
End If
M1:
Sheets ("иерархия") .Select
ActiveCell.Offset(-1, 1).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

End Sub
[moder]Тема закрыта из-за многочисленных нарушений Правил форума. Перечислять пункты лениво. Ибо дохренищщща их, нарушенных.

Автор - Андрей М
Дата добавления - 27.01.2014 в 22:24

Прошу помощи по макросу (Формулы)

Страница 1 из 1
1