Добрый день. Файл Excel во вложении. заполняются листы "Товары", "Сотрудники".На листе "Прайс" выбирается товар из списка, ставится количество и цена (берется например из счета-фактуры)-приход. на листе "Раздача" делается расход. Выбираем сотрудника и заполняем количество выданного товара. В шапке на листе "Раздача" наименование товара проставляется автоматически, берется с листа "Прайс". Суть проблемы в том, что нужно заполнить лист "Расшифровка" данными из листа "Раздача", где переносилась ФИО, наименование выданного товара и сумма этого товара по каждому наименованию, в конце итоговая сумма по ФИО. Есть макрос с помощью которого можно скрыть не нужные столбцы на листе "Раздача" с количеством и ценой. [vba]
Код
Sub HideCell() Application.ScreenUpdating = False Dim iCell As Range For Each iCell In ActiveSheet.UsedRange.Rows(14).Cells If iCell.Value = "кол" Then iCell.Columns.Hidden = Not iCell.Columns.Hidden ElseIf iCell.Value = "цена" Then iCell.Columns.Hidden = Not iCell.Columns.Hidden End If Next Application.ScreenUpdating = True End Sub
[/vba] Т.е я могу скрыть колонки таблицы с количеством и ценой. Проблема в объединенных ячейках содержащих наименование товара, не могу разобраться как перенести данные на лист ""Расшифровка". Может быть перенести "сумму" с удалением столбцов "кол" и "цена" на лист "Расшифровка" макросом. Не знаю как подобное сделать в макросе, чтобы осталось наименование товара и сумма.
Добрый день. Файл Excel во вложении. заполняются листы "Товары", "Сотрудники".На листе "Прайс" выбирается товар из списка, ставится количество и цена (берется например из счета-фактуры)-приход. на листе "Раздача" делается расход. Выбираем сотрудника и заполняем количество выданного товара. В шапке на листе "Раздача" наименование товара проставляется автоматически, берется с листа "Прайс". Суть проблемы в том, что нужно заполнить лист "Расшифровка" данными из листа "Раздача", где переносилась ФИО, наименование выданного товара и сумма этого товара по каждому наименованию, в конце итоговая сумма по ФИО. Есть макрос с помощью которого можно скрыть не нужные столбцы на листе "Раздача" с количеством и ценой. [vba]
Код
Sub HideCell() Application.ScreenUpdating = False Dim iCell As Range For Each iCell In ActiveSheet.UsedRange.Rows(14).Cells If iCell.Value = "кол" Then iCell.Columns.Hidden = Not iCell.Columns.Hidden ElseIf iCell.Value = "цена" Then iCell.Columns.Hidden = Not iCell.Columns.Hidden End If Next Application.ScreenUpdating = True End Sub
[/vba] Т.е я могу скрыть колонки таблицы с количеством и ценой. Проблема в объединенных ячейках содержащих наименование товара, не могу разобраться как перенести данные на лист ""Расшифровка". Может быть перенести "сумму" с удалением столбцов "кол" и "цена" на лист "Расшифровка" макросом. Не знаю как подобное сделать в макросе, чтобы осталось наименование товара и сумма.blood
Sub fill_table() Dim arr, lr As Long, lc As Long, i As Long, j As Long ' загрузка данных в массив With Worksheets("Раздача") lr = .Cells(.Rows.Count, 1).End(xlUp).Row arr = .Range("A17:N" & lr) ' здесь последний столбец - N (при необходимости изменить на последний столбец) End With ' заполнение листа Расшифровка With Worksheets("Расшифровка") lr = 8 ' номер первой строки для выгрузки данных на лист lc = 2 ' номер первого столбца (для фамилии) For j = LBound(arr, 1) To UBound(arr, 1) .Cells(lr, lc) = arr(j, 1) lc = lc + 1 For i = 5 To UBound(arr, 2) Step 3 ' цикл начинается с 5 столбца & _ (суммы по полю Бумага на листе Раздача) с шагом 3 .Cells(lr, lc) = arr(j, i) lc = lc + 1 Next i lc = 2: lr = lr + 1 Next j End With End Sub
[/vba] Запускать по Alt+F8 -> fill_table Код находится в модуле с именем "заполнить_расшифровку"
blood, приветствую! Можно, например так: [vba]
Код
Sub fill_table() Dim arr, lr As Long, lc As Long, i As Long, j As Long ' загрузка данных в массив With Worksheets("Раздача") lr = .Cells(.Rows.Count, 1).End(xlUp).Row arr = .Range("A17:N" & lr) ' здесь последний столбец - N (при необходимости изменить на последний столбец) End With ' заполнение листа Расшифровка With Worksheets("Расшифровка") lr = 8 ' номер первой строки для выгрузки данных на лист lc = 2 ' номер первого столбца (для фамилии) For j = LBound(arr, 1) To UBound(arr, 1) .Cells(lr, lc) = arr(j, 1) lc = lc + 1 For i = 5 To UBound(arr, 2) Step 3 ' цикл начинается с 5 столбца & _ (суммы по полю Бумага на листе Раздача) с шагом 3 .Cells(lr, lc) = arr(j, i) lc = lc + 1 Next i lc = 2: lr = lr + 1 Next j End With End Sub
[/vba] Запускать по Alt+F8 -> fill_table Код находится в модуле с именем "заполнить_расшифровку"jun
jun, Добрый день. Спасибо за макрос. Проблема в том что если указать последний столбец таблицы IF (сделано с запасом для пользователей, чтобы сами не добавляли столбцы с формулами). Расшифровка заполнится 0 Нужно чтобы Расшифровка масштабировалась в зависимости от ФИО, указанных в "Раздаче" и Товара выбранного в "Прайс". По ФИО масштабируется замечательно, по Товару не совсем корректно. Во вложении то что получилось после работы макроса если добавили ФИО и новый товар. С комментариями.
jun, Добрый день. Спасибо за макрос. Проблема в том что если указать последний столбец таблицы IF (сделано с запасом для пользователей, чтобы сами не добавляли столбцы с формулами). Расшифровка заполнится 0 Нужно чтобы Расшифровка масштабировалась в зависимости от ФИО, указанных в "Раздаче" и Товара выбранного в "Прайс". По ФИО масштабируется замечательно, по Товару не совсем корректно. Во вложении то что получилось после работы макроса если добавили ФИО и новый товар. С комментариями.blood
blood, пожалуйста. Понял Вас. P.S. забыл уточнить, что макрос собирает данные в массив до первого нуля. То есть, на листе "Раздача" загрузка наименований в массив (бумага, ручки и т.д.) идет до первого встреченного нуля. После этого код продолжает работу дальше.
blood, пожалуйста. Понял Вас. P.S. забыл уточнить, что макрос собирает данные в массив до первого нуля. То есть, на листе "Раздача" загрузка наименований в массив (бумага, ручки и т.д.) идет до первого встреченного нуля. После этого код продолжает работу дальше.jun
Сообщение отредактировал jun - Пятница, 03.03.2023, 18:06