Здравствуйте. Помогите, пожалуйста, как сделать, чтобы при нажатии на картинку добавлялась строка в умной таблице, и в первый столбец (№) подставлялась цифра первого столбца (№) из другого листа (прайс), в зависимости от нажатой картинки. При нажатии нескольких раз на одну картинку - суммировать количество в строке, если таковая уже имеется
Здравствуйте. Помогите, пожалуйста, как сделать, чтобы при нажатии на картинку добавлялась строка в умной таблице, и в первый столбец (№) подставлялась цифра первого столбца (№) из другого листа (прайс), в зависимости от нажатой картинки. При нажатии нескольких раз на одну картинку - суммировать количество в строке, если таковая уже имеетсяscryde2015
Можно например так. Но для каждой картинки нужно будет прописывать наименование в коде вручную для поиска на листе "Прайс". В коде выделил комментариями. Код: [vba]
Код
Sub find_beer_bottle_003() Dim rng_beer As Range, main_beer As Range, objTable As ListObject Dim InsertRow As Range
Set rng_beer = Worksheets("Прайс").Cells.Find("пиво баночное ""АСАХИ SUPER DRY"" ящик 350мл*") ' название поменять на нужное With Worksheets("Заказ") Set main_beer = .Cells.Find("пиво баночное ""АСАХИ SUPER DRY"" ящик 350мл*") ' то же Set objTable = .ListObjects("Реестр_tb") End With If Not rng_beer Is Nothing Then If main_beer Is Nothing Then objTable.ListRows.Add With Worksheets("Заказ") Set InsertRow = .Cells(2, 1).End(xlDown).Offset(1, 0) Debug.Print InsertRow.Address End With With Worksheets("Прайс") .Range(.Cells(rng_beer.Row, 1), .Cells(rng_beer.Row, 3)).Copy InsertRow InsertRow.Offset(0, 3) = 1 End With Else main_beer.Offset(0, 2) = main_beer.Offset(0, 2) + 1 End If Else MsgBox "Не удалось найти продукт по наименованию на листе Прайс!!!" End If End Sub Sub find_beer_bottle_004() Dim rng_beer As Range, main_beer As Range, objTable As ListObject Dim InsertRow As Range
Set rng_beer = Worksheets("Прайс").Cells.Find("пиво бутылочное ""АСАХИ SUPER DRY"" ящик 633мл*") ' название поменять на нужное With Worksheets("Заказ") Set main_beer = .Cells.Find("пиво бутылочное ""АСАХИ SUPER DRY"" ящик 633мл*") ' то же Set objTable = .ListObjects("Реестр_tb") End With If Not rng_beer Is Nothing Then If main_beer Is Nothing Then objTable.ListRows.Add With Worksheets("Заказ") Set InsertRow = .Cells(2, 1).End(xlDown).Offset(1, 0) Debug.Print InsertRow.Address End With With Worksheets("Прайс") .Range(.Cells(rng_beer.Row, 1), .Cells(rng_beer.Row, 3)).Copy InsertRow InsertRow.Offset(0, 3) = 1 End With Else main_beer.Offset(0, 2) = main_beer.Offset(0, 2) + 1 End If Else MsgBox "Не удалось найти продукт по наименованию на листе Прайс!!!" End If End Sub
[/vba]
Можно например так. Но для каждой картинки нужно будет прописывать наименование в коде вручную для поиска на листе "Прайс". В коде выделил комментариями. Код: [vba]
Код
Sub find_beer_bottle_003() Dim rng_beer As Range, main_beer As Range, objTable As ListObject Dim InsertRow As Range
Set rng_beer = Worksheets("Прайс").Cells.Find("пиво баночное ""АСАХИ SUPER DRY"" ящик 350мл*") ' название поменять на нужное With Worksheets("Заказ") Set main_beer = .Cells.Find("пиво баночное ""АСАХИ SUPER DRY"" ящик 350мл*") ' то же Set objTable = .ListObjects("Реестр_tb") End With If Not rng_beer Is Nothing Then If main_beer Is Nothing Then objTable.ListRows.Add With Worksheets("Заказ") Set InsertRow = .Cells(2, 1).End(xlDown).Offset(1, 0) Debug.Print InsertRow.Address End With With Worksheets("Прайс") .Range(.Cells(rng_beer.Row, 1), .Cells(rng_beer.Row, 3)).Copy InsertRow InsertRow.Offset(0, 3) = 1 End With Else main_beer.Offset(0, 2) = main_beer.Offset(0, 2) + 1 End If Else MsgBox "Не удалось найти продукт по наименованию на листе Прайс!!!" End If End Sub Sub find_beer_bottle_004() Dim rng_beer As Range, main_beer As Range, objTable As ListObject Dim InsertRow As Range
Set rng_beer = Worksheets("Прайс").Cells.Find("пиво бутылочное ""АСАХИ SUPER DRY"" ящик 633мл*") ' название поменять на нужное With Worksheets("Заказ") Set main_beer = .Cells.Find("пиво бутылочное ""АСАХИ SUPER DRY"" ящик 633мл*") ' то же Set objTable = .ListObjects("Реестр_tb") End With If Not rng_beer Is Nothing Then If main_beer Is Nothing Then objTable.ListRows.Add With Worksheets("Заказ") Set InsertRow = .Cells(2, 1).End(xlDown).Offset(1, 0) Debug.Print InsertRow.Address End With With Worksheets("Прайс") .Range(.Cells(rng_beer.Row, 1), .Cells(rng_beer.Row, 3)).Copy InsertRow InsertRow.Offset(0, 3) = 1 End With Else main_beer.Offset(0, 2) = main_beer.Offset(0, 2) + 1 End If Else MsgBox "Не удалось найти продукт по наименованию на листе Прайс!!!" End If End Sub
Можно например так. Но для каждой картинки нужно будет прописывать наименование в коде вручную для поиска на листе "Прайс". В коде выделил комментариями. Код:
Что-то совсем сложно получается) Получилось что-то такое сделать. Только не могу понять, как сделать так, чтобы была проверка, если позиция в списке уже имеется - добавлялось только количество к уже имеющийся строке, а если позиции нет - добавлять строку Ввожу номер в форму, по номеру ищет совпадение в прайсе - поставляет в форму. А вот как сделать проверку в таблице заказа - немогу понять )
Можно например так. Но для каждой картинки нужно будет прописывать наименование в коде вручную для поиска на листе "Прайс". В коде выделил комментариями. Код:
Что-то совсем сложно получается) Получилось что-то такое сделать. Только не могу понять, как сделать так, чтобы была проверка, если позиция в списке уже имеется - добавлялось только количество к уже имеющийся строке, а если позиции нет - добавлять строку Ввожу номер в форму, по номеру ищет совпадение в прайсе - поставляет в форму. А вот как сделать проверку в таблице заказа - немогу понять )scryde2015
А нет, не совсем все хорошо ) Он проверку то делает, вот только добавляет по 1, если в количестве указать больше 1 - в уже имеющуюся строку он добавляет все равно +1, а не то количество, которое указано в форме
А нет, не совсем все хорошо ) Он проверку то делает, вот только добавляет по 1, если в количестве указать больше 1 - в уже имеющуюся строку он добавляет все равно +1, а не то количество, которое указано в формеscryde2015
Сообщение отредактировал Serge_007 - Понедельник, 13.02.2023, 10:59