Доброго времени суток!!! Продолжаю свое маленькое дело по огромному облегчению жизни) Огромное вам спасибо за помощь!!! Документ почти готов осталось реализовать две идеи, Огромное просьба окажите содействие)
Документ в примере выложен полностью что на данный момент у меня получилось. Суть идеи: 1. Лист "МПС" данные с этого листа, перенести на лист "выданный мпс"согласно таблицы (примерное содержание таблицы 200 строк), при условии в графе "операции", условия "выдан" из выпадающего списка. При условии "выдан" строка должна обнулится (Макрос присутствует, Огромное спасибо Nic70y, за него!!! ) 2. После действия 1, на листе "данные" в таблице "№мпс" данные с номером должны удалится.
В примере все выделил желтым. Огромная просьба ребят подсобите плиз!!! и останется 1 идея для реализации и вы не представляете как облегчится моя трудовая деятельность. [offtop]забыл сказать что на листе "выданный мпс" данные должны сами удаляется по мере добавления новых
Доброго времени суток!!! Продолжаю свое маленькое дело по огромному облегчению жизни) Огромное вам спасибо за помощь!!! Документ почти готов осталось реализовать две идеи, Огромное просьба окажите содействие)
Документ в примере выложен полностью что на данный момент у меня получилось. Суть идеи: 1. Лист "МПС" данные с этого листа, перенести на лист "выданный мпс"согласно таблицы (примерное содержание таблицы 200 строк), при условии в графе "операции", условия "выдан" из выпадающего списка. При условии "выдан" строка должна обнулится (Макрос присутствует, Огромное спасибо Nic70y, за него!!! ) 2. После действия 1, на листе "данные" в таблице "№мпс" данные с номером должны удалится.
В примере все выделил желтым. Огромная просьба ребят подсобите плиз!!! и останется 1 идея для реализации и вы не представляете как облегчится моя трудовая деятельность. [offtop]забыл сказать что на листе "выданный мпс" данные должны сами удаляется по мере добавления новых
забыл сказать что на листе "выданный мпс" данные должны сами удаляется по мере добавления новых
а вот здесь нужно по подробнее. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next a = Target.Column b = Target.Row c = Target.Validation.Type If (a = 5 Or a = 10 Or a = 15) And b > 6 And c = 3 Then u = Target.Value If u = "выдан" Then f = Sheets("выданный мпс").Cells(Rows.Count, "a").End(xlUp).Row + 1 Sheets("выданный мпс").Range("a" & f & ":b" & f) = Range(Cells(b, a - 4), Cells(b, a - 3)).Value Sheets("выданный мпс").Range("c" & f).NumberFormat = "dd/mm/yyyy h:mm;@" Sheets("выданный мпс").Range("c" & f) = Now Range(Cells(b, a), Cells(b, a - 4)).ClearContents End If End If End Sub
забыл сказать что на листе "выданный мпс" данные должны сами удаляется по мере добавления новых
а вот здесь нужно по подробнее. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next a = Target.Column b = Target.Row c = Target.Validation.Type If (a = 5 Or a = 10 Or a = 15) And b > 6 And c = 3 Then u = Target.Value If u = "выдан" Then f = Sheets("выданный мпс").Cells(Rows.Count, "a").End(xlUp).Row + 1 Sheets("выданный мпс").Range("a" & f & ":b" & f) = Range(Cells(b, a - 4), Cells(b, a - 3)).Value Sheets("выданный мпс").Range("c" & f).NumberFormat = "dd/mm/yyyy h:mm;@" Sheets("выданный мпс").Range("c" & f) = Now Range(Cells(b, a), Cells(b, a - 4)).ClearContents End If End If End Sub
2. После действия 1, на листе "данные" в таблице "№мпс" данные с номером должны удалится.
а можно как то реализовать удаление с листа "данные", из таблицы "номер мпс" после добавления информации в лист "выданный мпс", а то выпадающий список получается большим, данные которые попали на лист выданный мпс с ними работа прекращена и информация о них не нужна в листе "данные" в таблице "номер мпс"
Nic70y, блин классно! Огромное спасибо!!! Всех благ вам в жизни!!!
2. После действия 1, на листе "данные" в таблице "№мпс" данные с номером должны удалится.
а можно как то реализовать удаление с листа "данные", из таблицы "номер мпс" после добавления информации в лист "выданный мпс", а то выпадающий список получается большим, данные которые попали на лист выданный мпс с ними работа прекращена и информация о них не нужна в листе "данные" в таблице "номер мпс"gfkq
Сообщение отредактировал gfkq - Понедельник, 07.02.2022, 11:19
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next a = Target.Column b = Target.Row c = Target.Validation.Type If (a = 5 Or a = 10 Or a = 15) And b > 6 And c = 3 Then u = Target.Value If u = "выдан" Then f = Sheets("выданный мпс").Cells(Rows.Count, "a").End(xlUp).Row + 1 Sheets("выданный мпс").Range("a" & f & ":b" & f) = Range(Cells(b, a - 4), Cells(b, a - 3)).Value Sheets("выданный мпс").Range("c" & f).NumberFormat = "dd/mm/yyyy h:mm;@" Sheets("выданный мпс").Range("c" & f) = Now If f > 201 Then Sheets("выданный мпс").Range("a2:c2").Delete g = Sheets("данные").Range("Таблица17").Find(What:=Cells(b, a - 4).Value).Address Sheets("данные").Range(g).Delete Range(Cells(b, a), Cells(b, a - 4)).ClearContents End If End If End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next a = Target.Column b = Target.Row c = Target.Validation.Type If (a = 5 Or a = 10 Or a = 15) And b > 6 And c = 3 Then u = Target.Value If u = "выдан" Then f = Sheets("выданный мпс").Cells(Rows.Count, "a").End(xlUp).Row + 1 Sheets("выданный мпс").Range("a" & f & ":b" & f) = Range(Cells(b, a - 4), Cells(b, a - 3)).Value Sheets("выданный мпс").Range("c" & f).NumberFormat = "dd/mm/yyyy h:mm;@" Sheets("выданный мпс").Range("c" & f) = Now If f > 201 Then Sheets("выданный мпс").Range("a2:c2").Delete g = Sheets("данные").Range("Таблица17").Find(What:=Cells(b, a - 4).Value).Address Sheets("данные").Range(g).Delete Range(Cells(b, a), Cells(b, a - 4)).ClearContents End If End If End Sub
В принципе это не очень важно, что бы данные не скапливались, после к примеру 200 строк, после 200 строки старые данные удалялись. Руками удалю.
если у вас есть возможность, можно ли подправить добавление на лист "выданный мпс" (получается что добавление информации происходит в строчку ниже предыдущей и по достижении 200ой строки обновляется одна двухсотая строка.)
можно ли сделать так, что- бы новая информация на листе "выданный мпс" добавлялась в самый вверх листа, а старая информация как бы сползала вниз, и тогда когда она достигнет 200ой строчки удалится. При много вам благодарен!!!
Многоуважаемый Nic70y, прошу меня извинить, что все не упокоюсь.
В принципе это не очень важно, что бы данные не скапливались, после к примеру 200 строк, после 200 строки старые данные удалялись. Руками удалю.
если у вас есть возможность, можно ли подправить добавление на лист "выданный мпс" (получается что добавление информации происходит в строчку ниже предыдущей и по достижении 200ой строки обновляется одна двухсотая строка.)
можно ли сделать так, что- бы новая информация на листе "выданный мпс" добавлялась в самый вверх листа, а старая информация как бы сползала вниз, и тогда когда она достигнет 200ой строчки удалится. При много вам благодарен!!!gfkq
Сообщение отредактировал gfkq - Среда, 09.02.2022, 14:17
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next a = Target.Column b = Target.Row c = Target.Validation.Type If (a = 5 Or a = 10 Or a = 15) And b > 6 And c = 3 Then u = Target.Value If u = "выдан" Then Sheets("выданный мпс").Range("a2:c2").Insert Shift:=xlDown Sheets("выданный мпс").Range("a2:c2") = Range(Cells(b, a - 4), Cells(b, a - 3)).Value Sheets("выданный мпс").Range("c2").NumberFormat = "dd/mm/yyyy h:mm;@" Sheets("выданный мпс").Range("c2") = Now Sheets("выданный мпс").Range("a202:c202").Clear g = Sheets("данные").Range("Таблица17").Find(What:=Cells(b, a - 4).Value).Address Sheets("данные").Range(g).Delete Range(Cells(b, a), Cells(b, a - 4)).ClearContents End If End If End Sub
[/vba] в этом месте Sheets("выданный мпс").Range("a202:c202").Clear будет всегда стираться строка 202 (т.е. в данном случае самая старая)
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next a = Target.Column b = Target.Row c = Target.Validation.Type If (a = 5 Or a = 10 Or a = 15) And b > 6 And c = 3 Then u = Target.Value If u = "выдан" Then Sheets("выданный мпс").Range("a2:c2").Insert Shift:=xlDown Sheets("выданный мпс").Range("a2:c2") = Range(Cells(b, a - 4), Cells(b, a - 3)).Value Sheets("выданный мпс").Range("c2").NumberFormat = "dd/mm/yyyy h:mm;@" Sheets("выданный мпс").Range("c2") = Now Sheets("выданный мпс").Range("a202:c202").Clear g = Sheets("данные").Range("Таблица17").Find(What:=Cells(b, a - 4).Value).Address Sheets("данные").Range(g).Delete Range(Cells(b, a), Cells(b, a - 4)).ClearContents End If End If End Sub
[/vba] в этом месте Sheets("выданный мпс").Range("a202:c202").Clear будет всегда стираться строка 202 (т.е. в данном случае самая старая)Nic70y