Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Удаление строки, при условии, Excel должен удалять строку с "Замечаний нет", после выполнения некоторого условия.
 
#1
04.04.2026 12:01:30
Имеется таблица excel. В ней, на листе "Основная" представлена база данных по оборудованию. Периодически проводятся его осмотры и выявление замечаний (дефектов). При их обнаружении они заносятся в эту таблицу. Но, если никаких дефектов не было обнаружено, то заносится фраза "Замечаний нет" (Столбец "D").
Но потом это же оборудование может быть осмотрено еще несколько раз (другие работы проводились), то замечания появятся и их тоже нужно будет внести, но уже в других строках. По одной строке на замечание. Так вот, нужно, чтобы при появлении дополнительных строк с одним названием оборудования, на объекте замечаний и занесении его в таблицу, строка "Замечаний нет" удалялась автоматически!
Изменено: Levanton - 05.04.2026 16:45:39
 
 
 
#2
04.04.2026 13:55:33
Цитата
Levanton написал: Имеется таблица excel....
В файле 5 листов, на каждом как минимум по одной таблице. О чем конкретно речь? Куда что вносится? Откуда удалять надо? Вы понимаете что такое файл-ПРИМЕР? Лишние данные только вносят смуту
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
05.04.2026 16:45:52
Изменил.
 
 
 
#4
05.04.2026 18:06:14
pq
 
 
 
#5
06.04.2026 06:30:33
Цитата
написал:
let    f=(x)=>List.Contains(List.RemoveLastN(List.Distinct(x)),"Замечаний нет"),    g=(x,y)=>not (List.Contains(lst,x) and y="Замечаний нет"),    from = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],    gr = Table.Group(from,"Объект",{"tmp",each f([Замечание])}),    lst = List.Buffer(Table.SelectRows(gr,each[tmp])[Объект]),    to = Table.SelectRows(from,each g([Объект],[Замечание]))in    to
Это же часть кода, как я понимаю?
 
 
 
#6
06.04.2026 06:34:39
Это функция написанная в PQ на языке M
П.С.
И не нужно цитировать все подряд.
Что-бы ответить конкретному пользователю достаточно нажать на Имя внизу его сообщения. Исправьте
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
06.04.2026 07:05:32
А как-нибудь по старинке можно, через VBA? У меня на рабочем компе в Excel нет такого инструмента, надстройки ставить нельзя
 
 
 
#8
06.04.2026 08:28:49
Цитата
Levanton написал:
У меня на рабочем компе в Excel нет такого инструмента
а какой у вас офис? Так у Вас в файле уже есть запрос, может Вы просто не знаете, что такое Power Query?
Изменено: Msi2102 - 06.04.2026 09:15:47
 
 
 
#9
06.04.2026 10:33:42
Я в нем слаб.
 
 
 
#10
06.04.2026 10:56:29
Думаю Вам не хватает ещё одного столбца с датой самого замечания, тогда будет видно, что к примеру 29.04.2026 замечаний не было, а 30.04.2026 замечания появились, и может удалять ничего не нужно будет
 
 
 
#11
06.04.2026 11:07:39
Код
Sub Удалить_замечаний_нет()
    Dim tb As ListObject
    Set tb = Sheets("Основная").ListObjects("Таблица1")
    
    Dim yt As Long, res As Range, obj As Range
    For yt = tb.DataBodyRange.Rows.Count To 1 Step -1
        If tb.ListColumns("Замечание").DataBodyRange.Cells(yt, 1).Value = "Замечаний нет" Then
            Set res = tb.ListColumns("УЭС/РЭС").DataBodyRange.Cells(yt, 1)
            Set obj = tb.ListColumns("Объект").DataBodyRange.Cells(yt, 1)
            If WorksheetFunction.CountIfs(res.Resize(tb.DataBodyRange.Rows.Count), res.Value, obj.Resize(tb.DataBodyRange.Rows.Count), obj.Value) > 1 Then
                tb.ListRows(yt).Delete
            End If
        End If
    Next
End Sub
Неоднозначно описаны условия для удаления. В примере зелёным выделены строки, которые не совсем попадают под описанные условия. Видимо, потребуются уточнения.
 
 
 
#12
06.04.2026 11:24:08
Всё работает! Спасибо, выручили, без этого бы сидел мучался месяца 2.
 
 
 
#13
06.04.2026 13:29:36
Ну я бы вот так делал
Код
' Удаление строк при вводе признака в ячейку
' "Del" - контрольный текст
' B2:B10 - контрольные ячейки
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Txt As String
Dim Nom As Long
If Not Intersect(Target, [B2:B10]) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Txt = Target.Value
    Nom = Target.Row
    If Txt = "Del" Then
        Rows(Nom & ":" & Nom).Delete Shift:=xlUp
    End If
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Адреса контроля и текст, при вводе которого строка удалится, сменить на нужный. Код листа
 
 
 
Страницы: 1
Читают тему
Наверх