Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Удаление строки в другого листа, ранее добавленной по макросу
 
#1
11.06.2025 10:12:05
Добрый день!

Совсем плохо разбираюсь в Эксель, помогите, пожалуйста.
На примерах получилось добавить макрос с помощью которого при установке знака "+" в графе "статус", строка автоматически попадала на второй лист. Но не понимаю, как прописать возможность про удаление знака "+" или поставив знак "-", строка со второго листа удалилась. На тот случай, если не туда поставил "+"

Пыталась прописать, но что-то идет не так.....
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Set trgt_rng = Range([C4], [C4].End(xlDown))
    
    If Target.Count = 1 Then
       If Target.Value = "+" Then
            Set out_rng = Worksheets("Коммерч").[A1].Offset(Cells.Rows.Count - 2).End(xlUp).Offset(1)
            Target.EntireRow.Copy out_rng
            Application.CutCopyMode = False
        End If
    End If
 
    Set trgt_rng = Range([C5], [C5].End(xlDown))
    If Target.Count = 1 Then
       If Target.Value = "-" Then
            Set out_rng = Worksheets("Коммерч").[A1].Offset(Cells.Rows.Count - 2).End(xlUp).Offset(1)
            Rows(1).EntireRow.Delete
            Application.Deleted = False
        End If
    End If

End Sub
 
 
 
#2
11.06.2025 10:51:27
Попробуйте так:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Set trgt_rng = Range([C4], [C4].End(xlDown))
    If Target.Count = 1 Then
        If Target.Value = "+" Then
            Set out_rng = Worksheets("Коммерч").[A1].Offset(Cells.Rows.Count - 2).End(xlUp).Offset(1)
            Target.EntireRow.Copy out_rng
            Application.CutCopyMode = False
        End If
        If Target.Value = "-" Then
            arr_1 = Worksheets("Коммерч").Range("A1:G" & Worksheets("Коммерч").Cells(Rows.Count, 2).End(xlUp).Row)
            For n = UBound(arr_1) To 1 Step -1
                If arr_1(n, 2) = Target.Offset(0, -3) Then Worksheets("Коммерч").Rows(n).Delete Shift:=xlUp
                Exit For ' Если нужно удалить все строки с таким оборудованием то закомментировать эту строку
            Next
        End If
    End If
End Sub
 
 
 
#3
11.06.2025 11:13:45
Msi2102, извините, не очень поняла.
Код
If arr_1(n, 2) = Target.Offset(0, -3) Then
- подсвечивает желтым
 
 
 
#4
11.06.2025 11:42:51
Немного ошибся
Попробуйте так
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Set trgt_rng = Range([C4], [C4].End(xlDown))
    If Target.Count = 1 Then
        If Target.Value = "+" Then
            Set out_rng = Worksheets("Коммерч").[A1].Offset(Cells.Rows.Count - 2).End(xlUp).Offset(1)
            Target.EntireRow.Copy out_rng
            Application.CutCopyMode = False
        End If
        If Target.Value = "-" Then
            arr_1 = Worksheets("Коммерч").Range("A1:G" & Worksheets("Коммерч").Cells(Rows.Count, 2).End(xlUp).Row)
            For n = UBound(arr_1) To 1 Step -1
                If arr_1(n, 2) = Target.Offset(0, -3).Value Then
                    Worksheets("Коммерч").Rows(n).Delete Shift:=xlUp
                    Exit For ' Если нужно удалить все строки с таким оборудованием то закомментировать эту строку
                End If
            Next
        End If
    End If
End Sub

У меня отрабатывает без ошибок
Изменено: Msi2102 - 11.06.2025 11:43:27
 
 
 
#5
11.06.2025 12:02:08
Msi2102, у меня, к сожалению, все равно на эту строку выдает ошибку. Может я что-то не верно делаю....
Код
Exit For ' Если нужно удалить все строки с таким оборудованием то закомментировать эту строку
- эту строку я пока убираю

на листе "База" ставлю статус "+", строка появляется на "Коммерч", так же на листе "База" ставлю "-" вместо "+" и по идее на листе "Коммерч" должно добавленная строка удалиться?
 
 
 
#6
11.06.2025 12:20:55
Исправил, не обратил внимание на слово статус, думал нужно в желтых ячейка менять
Код
Private Sub Worksheet_Change(ByVal Target As Range)
'    Set trgt_rng = Range([C4], [C4].End(xlDown))
    If Not Intersect(Target, Range("C:C")) Is Nothing Then
        If Target.Count = 1 Then
            If Target.Value = "+" Then
                Set out_rng = Worksheets("Коммерч").[A1].Offset(Cells.Rows.Count - 2).End(xlUp).Offset(1)
                Target.EntireRow.Copy out_rng
                Application.CutCopyMode = False
            End If
            If Target.Value = "-" Then
                arr_1 = Worksheets("Коммерч").Range("A1:G" & Worksheets("Коммерч").Cells(Rows.Count, 2).End(xlUp).Row)
                For n = UBound(arr_1) To 1 Step -1
                    If arr_1(n, 2) = Target.Offset(0, -1).Value Then
                        Worksheets("Коммерч").Rows(n).Delete Shift:=xlUp
                        Exit For ' Если нужно удалить все строки с таким оборудованием то закомментировать эту строку
                    End If
                Next
            End If
        End If
    End If
End Sub
 
 
 
#7
16.06.2025 03:03:42
Msi2102, Спасибо Вам Огромное!!!!! :*  
 
 
 
Страницы: 1
Читают тему
Наверх