Здравствуйте! Прошу помочь мне привести в удобочитаемый вид данные, расположенные в разных частях таблицы в приложенном архиве pantone Пытаюсь приблизиться в подаче внешней информации максимально как на фото, файл - цифровой аналог веера. С уважением, Артем
Здравствуйте! Прошу помочь мне привести в удобочитаемый вид данные, расположенные в разных частях таблицы в приложенном архиве pantone Пытаюсь приблизиться в подаче внешней информации максимально как на фото, файл - цифровой аналог веера. С уважением, Артемartika2000
Здравствуйте! Как мне кажется, Вы немного не в ту сторону двигаетесь - нет никакой гарантии, что производители ОС в ближайшее время не изменят коды RGB или еще что-то, связанное с цветовой палитрой. Может, лучше отталкиваться не от цвета, а от значений? Как они формируются? Либо макросом определять цвет RGB и потом его применять к нужным ячейкам.
Здравствуйте! Как мне кажется, Вы немного не в ту сторону двигаетесь - нет никакой гарантии, что производители ОС в ближайшее время не изменят коды RGB или еще что-то, связанное с цветовой палитрой. Может, лучше отталкиваться не от цвета, а от значений? Как они формируются? Либо макросом определять цвет RGB и потом его применять к нужным ячейкам._Igor_61
Сообщение отредактировал _Igor_61 - Четверг, 10.08.2017, 14:13
Если правильно понял. (обработку, если введено отсутствующее значение не делал)[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$12" Then Exit Sub If Target = Empty Then Exit Sub With Sheets("Pantone") Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End Sub
[/vba]
Если правильно понял. (обработку, если введено отсутствующее значение не делал)[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$12" Then Exit Sub If Target = Empty Then Exit Sub With Sheets("Pantone") Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End Sub
sboy, Спасибо Вам Вы все правильно поняли. Есть один момент, доделать, я все равно сходу не смогу. Все правильно работает, только как при каждом последующем наборе номера, если он состоит из 2х красок - а предидущий из 4-х, 3-я и 4-ая краски - остаются от старых значений в ячейках, а их бы убирать оттуда
sboy, Спасибо Вам Вы все правильно поняли. Есть один момент, доделать, я все равно сходу не смогу. Все правильно работает, только как при каждом последующем наборе номера, если он состоит из 2х красок - а предидущий из 4-х, 3-я и 4-ая краски - остаются от старых значений в ячейках, а их бы убирать оттудаartika2000
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$12" Then Exit Sub If Target = Empty Then Exit Sub Range("A14:B20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End Sub
[/vba]
artika2000, добавил [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$12" Then Exit Sub If Target = Empty Then Exit Sub Range("A14:B20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End Sub
sboy, Скажите пожалуйста если сможете, как на листе несколько Private Sub Worksheet_Change(ByVal Target As Range) обозначить. Цель: рядом еще такой же фрагмент хочу, делаю по подобию - не знаю как несколько Private Sub Worksheet_Change(ByVal Target As Range) разместить?
sboy, Скажите пожалуйста если сможете, как на листе несколько Private Sub Worksheet_Change(ByVal Target As Range) обозначить. Цель: рядом еще такой же фрагмент хочу, делаю по подобию - не знаю как несколько Private Sub Worksheet_Change(ByVal Target As Range) разместить?artika2000
If Target.Address <> "$A$12" Then Exit Sub If Target = Empty Then Exit Sub Range("A14:B20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With If Target.Address <> "$D$12" Then Exit Sub If Target = Empty Then Exit Sub Range("D14:C20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End Sub
[/vba]
Скажите при внесении информации в D12 жду появления в интервале D14:C20 не получаю ничего - зря жду?
_Boroda_, Udik, Да спасибо почитал уже про это.
[vba]
Код
If Target.Address <> "$A$12" Then Exit Sub If Target = Empty Then Exit Sub Range("A14:B20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With If Target.Address <> "$D$12" Then Exit Sub If Target = Empty Then Exit Sub Range("D14:C20").ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End Sub
[/vba]
Скажите при внесении информации в D12 жду появления в интервале D14:C20 не получаю ничего - зря жду?artika2000
Это не мне, это Сергею sboy спасибо. Я только кусочек в его макросе изменил Кстати, наверное вот так тогда (или типа того, я на ходу пишу, могу где-то накосячить) [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target = Empty Then Exit Sub ta_=Target.Address(0,0) If ta_ = "A12" or ta_ = "D12" or ta_ = "G12" or ta_ = "J12" Then Target.offset(2).resize(7,2).ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End If End Sub
[/vba]
Это не мне, это Сергею sboy спасибо. Я только кусочек в его макросе изменил Кстати, наверное вот так тогда (или типа того, я на ходу пишу, могу где-то накосячить) [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target = Empty Then Exit Sub ta_=Target.Address(0,0) If ta_ = "A12" or ta_ = "D12" or ta_ = "G12" or ta_ = "J12" Then Target.offset(2).resize(7,2).ClearContents With Sheets("Pantone") Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole) If Not fc Is Nothing Then Target.Interior.Color = fc.Interior.Color For ic = 5 To 19 If .Cells(fc.Row, ic) > 0 Then Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic) x = x + 1 End If Next ic End If End With End If End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
Но можно в зависимости от адреса разные ветки выполнять.
