Господа, есть таблица, с оборудованием. В ячейке b2 нужно сделать формулу =если(a1="на складе";"Ленина 105";"") но сделать так, чтобы если в а1 будет допустим Ип кузнецов, то в b2 можно было бы вбить его адрес, а формула бы сохранилась с приоритетом, и когда опять в а1 стало бы"на складе", в b2 сработала бы формула... бился и так и этак, ближе всего нашел условное форматирование, но не то. Таблица огромная, федеральная, мне кажется что ответ где то рядом. Будтье добры.
Господа, есть таблица, с оборудованием. В ячейке b2 нужно сделать формулу =если(a1="на складе";"Ленина 105";"") но сделать так, чтобы если в а1 будет допустим Ип кузнецов, то в b2 можно было бы вбить его адрес, а формула бы сохранилась с приоритетом, и когда опять в а1 стало бы"на складе", в b2 сработала бы формула... бился и так и этак, ближе всего нашел условное форматирование, но не то. Таблица огромная, федеральная, мне кажется что ответ где то рядом. Будтье добры.azzret
Сообщение отредактировал azzret - Четверг, 10.11.2022, 02:57
Добрый день. Нет, ип кузнецов не стабилен, там тысячи клиентов и добавляются новые, уходят старые...они заносятся в ручную. Формула должна быть как бы форматом ячеек столбца, но с возможностью прописи в них сторонних данных) неизменны лишь "на складе" и "ленина 105"
Добрый день. Нет, ип кузнецов не стабилен, там тысячи клиентов и добавляются новые, уходят старые...они заносятся в ручную. Формула должна быть как бы форматом ячеек столбца, но с возможностью прописи в них сторонних данных) неизменны лишь "на складе" и "ленина 105"azzret
вводите в столбец A - на складе вводите что-то другое, при этом заполните столбец B ниже в столбец A введите, то, что уже ввели выше - см. результат.
в модуле листа: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub Application.ScreenUpdating = False Application.EnableEvents = False u = Cells(Rows.Count, "a").End(xlUp).Row If Not Intersect(Target, Range("a1:a" & u)) Is Nothing Then a = Application.Match(Target.Value, Sheets("ÁÄ").Range("a:a"), 0) If IsNumeric(a) Then Target.Offset(0, 1) = Sheets("ÁÄ").Range("b" & a).Value Else Target.Offset(0, 1) = "" Target.Offset(0, 1).Select End If End If If Not Intersect(Target, Range("b1:b" & u)) Is Nothing Then a = Application.Match(Target.Offset(0, -1), Sheets("ÁÄ").Range("a:a"), 0) If IsNumeric(a) = False And Target.Offset(0, -1) <> "" And Target.Value <> "" Then b = Sheets("ÁÄ").Cells(Rows.Count, "a").End(xlUp).Row + 1 Sheets("ÁÄ").Range("a" & b & ":b" & b) = Range("a" & Target.Row & ":b" & Target.Row).Value End If End If Application.EnableEvents = True Application.ScreenUpdating = True End Sub
[/vba]
вводите в столбец A - на складе вводите что-то другое, при этом заполните столбец B ниже в столбец A введите, то, что уже ввели выше - см. результат.
в модуле листа: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub Application.ScreenUpdating = False Application.EnableEvents = False u = Cells(Rows.Count, "a").End(xlUp).Row If Not Intersect(Target, Range("a1:a" & u)) Is Nothing Then a = Application.Match(Target.Value, Sheets("ÁÄ").Range("a:a"), 0) If IsNumeric(a) Then Target.Offset(0, 1) = Sheets("ÁÄ").Range("b" & a).Value Else Target.Offset(0, 1) = "" Target.Offset(0, 1).Select End If End If If Not Intersect(Target, Range("b1:b" & u)) Is Nothing Then a = Application.Match(Target.Offset(0, -1), Sheets("ÁÄ").Range("a:a"), 0) If IsNumeric(a) = False And Target.Offset(0, -1) <> "" And Target.Value <> "" Then b = Sheets("ÁÄ").Cells(Rows.Count, "a").End(xlUp).Row + 1 Sheets("ÁÄ").Range("a" & b & ":b" & b) = Range("a" & Target.Row & ":b" & Target.Row).Value End If End If Application.EnableEvents = True Application.ScreenUpdating = True End Sub
Тормозить будет. Не советую В файле в УФ уберите знак $ в формуле, скопируйте В1 и вставьте там, где нужно. Она будет работать с соседней ячейкой слева И вообще - где ваш файл, почему мы придумываем что-то и рисуем? В правилах форума что написано?
Тормозить будет. Не советую В файле в УФ уберите знак $ в формуле, скопируйте В1 и вставьте там, где нужно. Она будет работать с соседней ячейкой слева И вообще - где ваш файл, почему мы придумываем что-то и рисуем? В правилах форума что написано?_Boroda_
А там понимать не нужно ))) Просто выполнить последовательность действий описанную. Войти в УФ, в формулу УФ, убрать $. Сохранить УФ. Скопировать ячейку, вставить в нужные места
А там понимать не нужно ))) Просто выполнить последовательность действий описанную. Войти в УФ, в формулу УФ, убрать $. Сохранить УФ. Скопировать ячейку, вставить в нужные места_Boroda_
Вот, файл сделал. Только наша таблица гигантская, 40 столбцов и тысячи строк. Нужно чтобы желтые менялись, по требованию главка менять местами столбцы нельзя.
Вот, файл сделал. Только наша таблица гигантская, 40 столбцов и тысячи строк. Нужно чтобы желтые менялись, по требованию главка менять местами столбцы нельзя.azzret
_Boroda_, Вот, файл сделал. Только наша таблица гигантская, 40 столбцов и тысячи строк. Нужно чтобы желтые менялись, по требованию главка менять местами столбцы нельзя.
_Boroda_, Вот, файл сделал. Только наша таблица гигантская, 40 столбцов и тысячи строк. Нужно чтобы желтые менялись, по требованию главка менять местами столбцы нельзя.azzret
Для адреса сделал, для остальных по аналогии. Но для таблиц я бы так не делал, меняется ведь только видимость, отображение, а реальное значение в ячейке не меняется. Я-то думал, что у Вас печатная форма какая-то, типа путевого листа. А в том случае, что у Вас - я бы макросом сделал
Для адреса сделал, для остальных по аналогии. Но для таблиц я бы так не делал, меняется ведь только видимость, отображение, а реальное значение в ячейке не меняется. Я-то думал, что у Вас печатная форма какая-то, типа путевого листа. А в том случае, что у Вас - я бы макросом сделал_Boroda_
Nic70y, Здравствуйте , а если не трудно можно к вашему макросу из сообщ 4 описание дать (подробно) что ьы смог у себя в файле "припилить" по аналогии
Nic70y, Здравствуйте , а если не трудно можно к вашему макросу из сообщ 4 описание дать (подробно) что ьы смог у себя в файле "припилить" по аналогииmicholap_denis
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub Application.ScreenUpdating = False Application.EnableEvents = False u = Cells(Rows.Count, "a").End(xlUp).Row 'нижняя заполненная ячейка столбца A If Not Intersect(Target, Range("a1:a" & u)) Is Nothing Then 'событие изменение диапазона с A1 до нижней a = Application.Match(Target.Value, Sheets("БД").Range("a:a"), 0) 'ищем введенное значение на лите БД в столбце A If IsNumeric(a) Then 'если значение найдено: Target.Offset(0, 1) = Sheets("БД").Range("b" & a).Value 'в ячейку правее (столбец B) вводим значение из БД столбца B Else 'если значение не найдено: Target.Offset(0, 1) = "" 'в ячейку правее (столбец B) вводим пустоту Target.Offset(0, 1).Select 'выделяем эту ячейку, для ввода нового адреса End If End If If Not Intersect(Target, Range("b1:b" & u)) Is Nothing Then 'событие изменение диапазона с B1 до нижней, т.е ввод адреса a = Application.Match(Target.Offset(0, -1), Sheets("БД").Range("a:a"), 0) 'проверяем БД на наличие значения столбца A If IsNumeric(a) = False And Target.Offset(0, -1) <> "" And Target.Value <> "" Then 'если не найдено и ячейки не пустые b = Sheets("БД").Cells(Rows.Count, "a").End(xlUp).Row + 1 Sheets("БД").Range("a" & b & ":b" & b) = Range("a" & Target.Row & ":b" & Target.Row).Value 'вносим новые данные End If End If Application.EnableEvents = True Application.ScreenUpdating = True End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub Application.ScreenUpdating = False Application.EnableEvents = False u = Cells(Rows.Count, "a").End(xlUp).Row 'нижняя заполненная ячейка столбца A If Not Intersect(Target, Range("a1:a" & u)) Is Nothing Then 'событие изменение диапазона с A1 до нижней a = Application.Match(Target.Value, Sheets("БД").Range("a:a"), 0) 'ищем введенное значение на лите БД в столбце A If IsNumeric(a) Then 'если значение найдено: Target.Offset(0, 1) = Sheets("БД").Range("b" & a).Value 'в ячейку правее (столбец B) вводим значение из БД столбца B Else 'если значение не найдено: Target.Offset(0, 1) = "" 'в ячейку правее (столбец B) вводим пустоту Target.Offset(0, 1).Select 'выделяем эту ячейку, для ввода нового адреса End If End If If Not Intersect(Target, Range("b1:b" & u)) Is Nothing Then 'событие изменение диапазона с B1 до нижней, т.е ввод адреса a = Application.Match(Target.Offset(0, -1), Sheets("БД").Range("a:a"), 0) 'проверяем БД на наличие значения столбца A If IsNumeric(a) = False And Target.Offset(0, -1) <> "" And Target.Value <> "" Then 'если не найдено и ячейки не пустые b = Sheets("БД").Cells(Rows.Count, "a").End(xlUp).Row + 1 Sheets("БД").Range("a" & b & ":b" & b) = Range("a" & Target.Row & ":b" & Target.Row).Value 'вносим новые данные End If End If Application.EnableEvents = True Application.ScreenUpdating = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
