Нужно сделать таблицу. 1-Есть таблица с ячейками, пронумерованными от 1 до 3200. и 2я- таблица названиями(в столбик) и в следующей(соседней) ячейки, любые номера через запятую в произвольном порядке. В диапазоне таком же как в первой таблице. Название1 151,25,23,289,1562 название2 1,2564,236,52,8,9 название3 6,89 ........... Название20 58,9,5,23,56,98,69,456,2639,5,789,1987,3010 и так далее. При клике по любому из названий в таблице№2, ячейки в таблице №1 меняли цвет.(по выбору пользователя) Пример. кликаем по названию3(в таблице2) Ячейки меняют цвет соответствующим цифрам =6,89 в таблице№1
Извиняюсь если некорректно объясненил.
Нужно сделать таблицу. 1-Есть таблица с ячейками, пронумерованными от 1 до 3200. и 2я- таблица названиями(в столбик) и в следующей(соседней) ячейки, любые номера через запятую в произвольном порядке. В диапазоне таком же как в первой таблице. Название1 151,25,23,289,1562 название2 1,2564,236,52,8,9 название3 6,89 ........... Название20 58,9,5,23,56,98,69,456,2639,5,789,1987,3010 и так далее. При клике по любому из названий в таблице№2, ячейки в таблице №1 меняли цвет.(по выбору пользователя) Пример. кликаем по названию3(в таблице2) Ячейки меняют цвет соответствующим цифрам =6,89 в таблице№1
Volt, Поменяйте название темы,предложите новое название, модераторы поменяют, и приложите файл-пример с вашими хотелками. в файле можно просто нарисовать то, что вы хотите ручками
Volt, Поменяйте название темы,предложите новое название, модераторы поменяют, и приложите файл-пример с вашими хотелками. в файле можно просто нарисовать то, что вы хотите ручкамикитин
Не судите очень строго:я пытаюсь научиться ЯД 41001877306852
Вы лучше тему переименовать попробуйте. Например в "Заливка выбранной ячейки заданным цветом". А то задача-то довольно тривиальная, но помощи Вы не получите, пока не будет осмысленного названия темы.
Вы лучше тему переименовать попробуйте. Например в "Заливка выбранной ячейки заданным цветом". А то задача-то довольно тривиальная, но помощи Вы не получите, пока не будет осмысленного названия темы.StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
Вы лучше тему переименовать попробуйте. Например в "Заливка выбранной ячейки заданным цветом". А то задача-то довольно тривиальная, но помощи Вы не получите, пока не будет осмысленного названия темы.
Вы лучше тему переименовать попробуйте. Например в "Заливка выбранной ячейки заданным цветом". А то задача-то довольно тривиальная, но помощи Вы не получите, пока не будет осмысленного названия темы.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(3)) Is Nothing Then Columns(3).Replace What:=".", Replacement:=",", LookAt:=xlPart
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Numbs() As String Dim Numb As Variant Dim cell As Range
If Target.Count = 1 Then With Worksheets(2) If InStr(1, Target.Value, "Название", vbTextCompare) > 0 Then .UsedRange.Interior.Color = Cells(1, 6).Interior.Color Numbs = Split(Target.Offset(, 1), ",", -1, vbTextCompare) For Each Numb In Numbs Set cell = .UsedRange.Find(What:=Numb, LookIn:=xlValues, LookAt:=xlWhole) If Not cell Is Nothing Then cell.Interior.Color = Cells(8, 6).Interior.Color Next Numb End If If Not Intersect(Target, Cells(8, 6)) Is Nothing Then For Each cell In .UsedRange If cell.Interior.Color <> Cells(1, 6).Interior.Color Then cell.Interior.Color = Target.Interior.Color Next cell End If End With End If
End Sub
[/vba]в модуль листа 1. В ячейке 1,6 хранится образец стандартного цвета таблицы.
[vba]
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(3)) Is Nothing Then Columns(3).Replace What:=".", Replacement:=",", LookAt:=xlPart
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Numbs() As String Dim Numb As Variant Dim cell As Range
If Target.Count = 1 Then With Worksheets(2) If InStr(1, Target.Value, "Название", vbTextCompare) > 0 Then .UsedRange.Interior.Color = Cells(1, 6).Interior.Color Numbs = Split(Target.Offset(, 1), ",", -1, vbTextCompare) For Each Numb In Numbs Set cell = .UsedRange.Find(What:=Numb, LookIn:=xlValues, LookAt:=xlWhole) If Not cell Is Nothing Then cell.Interior.Color = Cells(8, 6).Interior.Color Next Numb End If If Not Intersect(Target, Cells(8, 6)) Is Nothing Then For Each cell In .UsedRange If cell.Interior.Color <> Cells(1, 6).Interior.Color Then cell.Interior.Color = Target.Interior.Color Next cell End If End With End If
End Sub
[/vba]в модуль листа 1. В ячейке 1,6 хранится образец стандартного цвета таблицы.StoTisteg