Доброго времени суток! Помогите пожалуйста найти функцию для заполнения таблицы. Таблица из 5000 строк. Уникальные строчки в ней заполнены, но существуют дубликаты. Комплектуем школу. В столбце "наименование" расписаны требующиеся позиции (столы, стулья, шторы, доски и т.д.) В разных кабинетах существуют уникальные позиции (стол для кабинета химии, физики), но много и повторяющихся (стулья, доски, шторы). Шесть столбцов справа заполняются ценами и поставщиками. Как сделать так, чтобы однажды заполненные строки, программа автоматически заполнила далее, исходя из названия предмета.
Доброго времени суток! Помогите пожалуйста найти функцию для заполнения таблицы. Таблица из 5000 строк. Уникальные строчки в ней заполнены, но существуют дубликаты. Комплектуем школу. В столбце "наименование" расписаны требующиеся позиции (столы, стулья, шторы, доски и т.д.) В разных кабинетах существуют уникальные позиции (стол для кабинета химии, физики), но много и повторяющихся (стулья, доски, шторы). Шесть столбцов справа заполняются ценами и поставщиками. Как сделать так, чтобы однажды заполненные строки, программа автоматически заполнила далее, исходя из названия предмета.Tattiana
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:A65536")) Is Nothing Then If Target.Cells.Count > 1 Then Exit Sub u = WorksheetFunction.Match(Target, Range("A1:A65536"), 0) Range("B" & Target.Row & ":G" & Target.Row) = Range("B" & u & ":G" & u).Value End If End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:A65536")) Is Nothing Then If Target.Cells.Count > 1 Then Exit Sub u = WorksheetFunction.Match(Target, Range("A1:A65536"), 0) Range("B" & Target.Row & ":G" & Target.Row) = Range("B" & u & ":G" & u).Value End If End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Count > 1 Then Exit Sub If Not Application.Intersect(Range("B:B"), Target) Is Nothing Then Range("B" & Target.Row & ":H" & Target.Row).Copy Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) End If Cancel = True End Sub
[/vba]
Или так. Двойным кликом по наименованию. [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Count > 1 Then Exit Sub If Not Application.Intersect(Range("B:B"), Target) Is Nothing Then Range("B" & Target.Row & ":H" & Target.Row).Copy Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) End If Cancel = True End Sub
китин, Nic70y, Wasilich, Спасибо большое. Оказалось, что знаний у меня на много меньше. Не работают у меня макросы эти. Можете помочь еще немного? Приложила кусок таблицы, посмотрите пожалуйста
китин, Nic70y, Wasilich, Спасибо большое. Оказалось, что знаний у меня на много меньше. Не работают у меня макросы эти. Можете помочь еще немного? Приложила кусок таблицы, посмотрите пожалуйстаTattiana
Nic70y, А вот еще вопрос: он может делать это автоматически? Проверять и вставлять где нужно. чтобы в каждую не заходить. Точнее их 5000 строк, умрешь пока каждую проверишь ( конечно, это уже на много проще, чем копировать и вставлять все)
Nic70y, А вот еще вопрос: он может делать это автоматически? Проверять и вставлять где нужно. чтобы в каждую не заходить. Точнее их 5000 строк, умрешь пока каждую проверишь ( конечно, это уже на много проще, чем копировать и вставлять все)Tattiana
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
[/p.s.][vba]
