Во время работы столкнулся со следующим вопросом: с помощью какого кода через макрос можно создать столбцы таблицы на основе значения из ячейки? Положим, если значение исходной ячейки А1 = 8, то начиная с ячейки Е1 создается таблица с 8-ью столбцами.
Совсем идеальным было бы, скажем если следующая исходная ячейка В1 = 2, то данные два столбца продолжают созданную вверху таблицу с 8-ю столбцами. Но это, как говорится, большое если...
Новый на форуме, поэтому буду благодарен за любой ответ
Доброго времени суток!
Во время работы столкнулся со следующим вопросом: с помощью какого кода через макрос можно создать столбцы таблицы на основе значения из ячейки? Положим, если значение исходной ячейки А1 = 8, то начиная с ячейки Е1 создается таблица с 8-ью столбцами.
Совсем идеальным было бы, скажем если следующая исходная ячейка В1 = 2, то данные два столбца продолжают созданную вверху таблицу с 8-ю столбцами. Но это, как говорится, большое если...
Новый на форуме, поэтому буду благодарен за любой ответwalkinghome
Грубо говоря, создается такого рода таблица вместе с определенным числом столбцов и чтобы там также отразились некоторые параметры (как например стоимость).
Но думаю суть в целом состоит из рисования границ по соответствующему количеству товара
Nic70y, извиняюсь, не учел, пример прикрепил.
Грубо говоря, создается такого рода таблица вместе с определенным числом столбцов и чтобы там также отразились некоторые параметры (как например стоимость).
Но думаю суть в целом состоит из рисования границ по соответствующему количеству товараwalkinghome
A - наименование B - кол-во C - стоимость столбец E образец формата (нарисуете как захотите) [vba]
Код
Sub u_711() Application.ScreenUpdating = False 'сотрем старые столбцы Range("e1:e9").ClearContents y = Cells(1, Columns.Count).End(xlToLeft).Column If y > 5 Then Range(Cells(1, "f"), Cells(9, y)).Clear 'составим новые a = Cells(Rows.Count, "a").End(xlUp).Row 'последняя заполненная строка столбца A If a > 1 Then For Each u In Range("a2:a" & a) 'проходимся циклом по товарам b = u.Value 'наименование c = u.Offset(0, 1) 'кол-во d = u.Offset(0, 2) 'стоимость e = Cells(1, Columns.Count).End(xlToLeft).Column + 1 'левый столбец для товара If e < 6 Then e = 5 f = e + c - 1 'правый столбец для товара Range(Cells(1, e), Cells(1, f)) = b 'заполняем наменованием Range(Cells(2, e), Cells(2, f)) = d 'заполняем стоимостью Next Else MsgBox "Нет данных!" End If 'формат по обзазцу столбца E g = Cells(1, Columns.Count).End(xlToLeft).Column If g > 5 Then Columns("e").Copy Range(Columns(6), Columns(g)).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End If Application.ScreenUpdating = True End Sub
[/vba]вносим данные, жмем кнопку
A - наименование B - кол-во C - стоимость столбец E образец формата (нарисуете как захотите) [vba]
Код
Sub u_711() Application.ScreenUpdating = False 'сотрем старые столбцы Range("e1:e9").ClearContents y = Cells(1, Columns.Count).End(xlToLeft).Column If y > 5 Then Range(Cells(1, "f"), Cells(9, y)).Clear 'составим новые a = Cells(Rows.Count, "a").End(xlUp).Row 'последняя заполненная строка столбца A If a > 1 Then For Each u In Range("a2:a" & a) 'проходимся циклом по товарам b = u.Value 'наименование c = u.Offset(0, 1) 'кол-во d = u.Offset(0, 2) 'стоимость e = Cells(1, Columns.Count).End(xlToLeft).Column + 1 'левый столбец для товара If e < 6 Then e = 5 f = e + c - 1 'правый столбец для товара Range(Cells(1, e), Cells(1, f)) = b 'заполняем наменованием Range(Cells(2, e), Cells(2, f)) = d 'заполняем стоимостью Next Else MsgBox "Нет данных!" End If 'формат по обзазцу столбца E g = Cells(1, Columns.Count).End(xlToLeft).Column If g > 5 Then Columns("e").Copy Range(Columns(6), Columns(g)).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End If Application.ScreenUpdating = True End Sub
Nic70y, небольшой вопрос: где именно необходимо сменить код, если таблица с вводимыми данными находится на первом листе (Лист1), а собранная после таблица на листе втором (Лист2)? Иными словами, дабы собранная таблица находилась на следующем листе
Nic70y, небольшой вопрос: где именно необходимо сменить код, если таблица с вводимыми данными находится на первом листе (Лист1), а собранная после таблица на листе втором (Лист2)? Иными словами, дабы собранная таблица находилась на следующем листеwalkinghome
Sub u_711() Application.ScreenUpdating = False 'сотрем старые столбцы Sheets("Лист2").Range("a1:a9").ClearContents y = Sheets("Лист2").Cells(1, Columns.Count).End(xlToLeft).Column If y > 1 Then Range(Sheets("Лист2").Cells(1, "b"), Sheets("Лист2").Cells(9, y)).Clear 'составим новые a = Cells(Rows.Count, "a").End(xlUp).Row 'последняя заполненная строка столбца A If a > 1 Then For Each u In Range("a2:a" & a) 'проходимся циклом по товарам b = u.Value 'наименование c = u.Offset(0, 1) 'кол-во d = u.Offset(0, 2) 'стоимость e = Sheets("Лист2").Cells(1, Columns.Count).End(xlToLeft).Column + 1 'левый столбец для товара If e = 2 And Sheets("Лист2").Range("a1") = "" Then e = 1 f = e + c - 1 'правый столбец для товара Range(Sheets("Лист2").Cells(1, e), Sheets("Лист2").Cells(1, f)) = b 'заполняем наменованием Range(Sheets("Лист2").Cells(2, e), Sheets("Лист2").Cells(2, f)) = d 'заполняем стоимостью Next Else MsgBox "Нет данных!" End If 'формат по обзазцу столбца E g = Sheets("Лист2").Cells(1, Columns.Count).End(xlToLeft).Column If g > 1 Then Sheets("Лист2").Columns("a").Copy Range(Sheets("Лист2").Columns(2), Sheets("Лист2").Columns(g)).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End If Application.ScreenUpdating = True End Sub
[/vba]
[vba]
Код
Sub u_711() Application.ScreenUpdating = False 'сотрем старые столбцы Sheets("Лист2").Range("a1:a9").ClearContents y = Sheets("Лист2").Cells(1, Columns.Count).End(xlToLeft).Column If y > 1 Then Range(Sheets("Лист2").Cells(1, "b"), Sheets("Лист2").Cells(9, y)).Clear 'составим новые a = Cells(Rows.Count, "a").End(xlUp).Row 'последняя заполненная строка столбца A If a > 1 Then For Each u In Range("a2:a" & a) 'проходимся циклом по товарам b = u.Value 'наименование c = u.Offset(0, 1) 'кол-во d = u.Offset(0, 2) 'стоимость e = Sheets("Лист2").Cells(1, Columns.Count).End(xlToLeft).Column + 1 'левый столбец для товара If e = 2 And Sheets("Лист2").Range("a1") = "" Then e = 1 f = e + c - 1 'правый столбец для товара Range(Sheets("Лист2").Cells(1, e), Sheets("Лист2").Cells(1, f)) = b 'заполняем наменованием Range(Sheets("Лист2").Cells(2, e), Sheets("Лист2").Cells(2, f)) = d 'заполняем стоимостью Next Else MsgBox "Нет данных!" End If 'формат по обзазцу столбца E g = Sheets("Лист2").Cells(1, Columns.Count).End(xlToLeft).Column If g > 1 Then Sheets("Лист2").Columns("a").Copy Range(Sheets("Лист2").Columns(2), Sheets("Лист2").Columns(g)).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End If Application.ScreenUpdating = True End Sub
Быстрый вопрос напоследок: как именно изменится код, если кнопка для выполнения макроса будет находиться на Лист1, исходная таблица на Лист2 и построенная таблица на Лист3?
По всему остальному макрос функционирует беспрекословно.
Nic70y, спасибо!
Быстрый вопрос напоследок: как именно изменится код, если кнопка для выполнения макроса будет находиться на Лист1, исходная таблица на Лист2 и построенная таблица на Лист3?
По всему остальному макрос функционирует беспрекословно.walkinghome
1) меняем Лист2 на Лист3 2)добавляем Лист2 сюда: [vba]
Код
'составим новые a = Sheets("Лист2").Cells(Rows.Count, "a").End(xlUp).Row 'последняя заполненная строка столбца A If a > 1 Then For Each u In Sheets("Лист2").Range("a2:a" & a) 'проходимся циклом по товарам
[/vba]
1) меняем Лист2 на Лист3 2)добавляем Лист2 сюда: [vba]
Код
'составим новые a = Sheets("Лист2").Cells(Rows.Count, "a").End(xlUp).Row 'последняя заполненная строка столбца A If a > 1 Then For Each u In Sheets("Лист2").Range("a2:a" & a) 'проходимся циклом по товарам
Единственное: в таблице редактирования значений (Лист2) если присутствуют значения "0" макрос всё же создает по ним столбцы. Понимаю, что явно прошу многого, но нет ли возможности этого избежать?
По своей сути единственная оставшаяся проблема на данный момент.
Nic70y, отлично, всё функционирует как надо.
Единственное: в таблице редактирования значений (Лист2) если присутствуют значения "0" макрос всё же создает по ним столбцы. Понимаю, что явно прошу многого, но нет ли возможности этого избежать?
По своей сути единственная оставшаяся проблема на данный момент.walkinghome
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
