Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1 2 След.
RSS
Автоматическое изменение цвета ячейки
 
#1
16.11.2011 20:50:04
Добрый день!  
Помогите изменить код таким образом, чтобы он проверял, какого цвета ячейка и если ячейка прозрачная, то только тогда применял L1: If Err > 0 Then x.Interior.ColorIndex = 6: Resume Next  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
Dim objRange As Object, x As Object  
Set objRange = UsedRange.Columns(Target.Column)  
objRange.Interior.ColorIndex = 0  
On Error GoTo L1  
With New Collection  
For Each x In objRange.Cells  
If x <> "" Then .Add x.Value, CStr(x.Value)  
Next  
End With  
L1: If Err > 0 Then x.Interior.ColorIndex = 6: Resume Next  
With Target.Font  
.Name = "Tahoma"  
.Size = 10  
.Strikethrough = False  
.Superscript = False  
.Subscript = False  
.OutlineFont = False  
.Shadow = False  
.Underline = xlUnderlineStyleNone  
.ColorIndex = 1  
End With  
End Sub
 
 
 
#2
16.11.2011 22:24:40
Точнее не много по другому.  
Помогите изменить код таким образом, чтобы он проверял, какого цвета ячейка и если ячейка прозрачная (без цвета), то только тогда применял следующий код  
[more]
Код
Private Sub Worksheet_Change(ByVal Target As Range)   
Dim objRange As Object, x As Object   
Set objRange = UsedRange.Columns(Target.Column)   
objRange.Interior.ColorIndex = 0   
On Error GoTo L1   
With New Collection   
For Each x In objRange.Cells   
If x <> "" Then .Add x.Value, CStr(x.Value)   
Next   
End With   
[color=#FF0000]L1: If Err > 0 Then x.Interior.ColorIndex = 6: Resume Next[/color]   
With Target.Font   
.Name = "Tahoma"   
.Size = 10   
.Strikethrough = False   
.Superscript = False   
.Subscript = False   
.OutlineFont = False   
.Shadow = False   
.Underline = xlUnderlineStyleNone   
.ColorIndex = 1   
End With   
End Sub
 
[/more]
 
 
 
#3
16.11.2011 22:31:40
Я чего-то не очень понимаю какую ячейку надо проверять и где, а проверить какая заливка у ячейки можно так:  
If range("a1").Interior.ColorIndex=xlNone then ...
 
 
 
#4
16.11.2011 22:35:49
Надо вставить    
Код
   
If x.Interior.ColorIndex = xlNone Then   
   
End If  
 
 
В какое-то место. Из описания не очень ясно в какое.
 
 
 
#5
16.11.2011 23:03:50
Понял, спасибо большое.  
А не могли еще помочь, а как сделать, чтобы код срабатывал, только при вставке текста в ячейки? именно при вставке текста в ячейки, а не добавления с помощью клавиатуры.
 
 
 
#6
16.11.2011 23:40:26
Точнее не так, как сделать, чтобы цвет ячейки менялся только для вновь созданного текста, а для остальных он бы не менялся?
 
 
 
#7
16.11.2011 23:41:24
если использовать вот этот код  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
Dim objRange As Object, x As Object  
Set objRange = UsedRange.Columns(Target.Column)  
objRange.Interior.ColorIndex = 0  
On Error GoTo L1  
With New Collection  
For Each x In objRange.Cells  
If x <> "" Then .Add x.Value, CStr(x.Value)  
Next  
End With  
L1: If Err > 0 Then x.Interior.ColorIndex = 6: Resume Next  
With Target.Font  
.Name = "Tahoma"  
.Size = 10  
.Strikethrough = False  
.Superscript = False  
.Subscript = False  
.OutlineFont = False  
.Shadow = False  
.Underline = xlUnderlineStyleNone  
.ColorIndex = 1  
End With  
End Sub
 
 
 
#8
17.11.2011 16:52:50
bond  
подскажите, а куда вставлять код?  
Суть в том, что должна быть проверка, если ячейка прозрачная то выполняем код, если нет, то код не выполняем для этой ячейки
 
 
 
#9
17.11.2011 23:17:46
Неужели ни кто не знает?
 
 
 
#10
18.11.2011 12:32:37
добрый день!  
Подскажите, почему код не работает?  
суть в том, что если ячейка прозрачная, то она должна быть перекрашена в желтый цвет L1: If Err > 0 Then If x.Interior.ColorIndex = xlNone Then x.Interior.ColorIndex = 6: Resume Next  
Но почему не работает, не понимаю?  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
Dim objRange As Object, x As Object  
Set objRange = UsedRange.Columns(Target.Column)  
objRange.Interior.ColorIndex = 0  
On Error GoTo L1  
With New Collection  
For Each x In objRange.Cells  
If x <> "" Then .Add x.Value, CStr(x.Value)  
Next  
End With  
L1: If Err > 0 Then If x.Interior.ColorIndex = xlNone Then x.Interior.ColorIndex = 6: Resume Next  
With Target.Font  
.Name = "Tahoma"  
.Size = 10  
.Strikethrough = False  
.Superscript = False  
.Subscript = False  
.OutlineFont = False  
.Shadow = False  
.Underline = xlUnderlineStyleNone  
.ColorIndex = 1  
End With  
End Sub
 
 
 
#11
18.11.2011 18:39:44
Может просто..  
Private Sub Worksheet_Change(ByVal Target As Range)  
If Intersect(Target, Columns(1)) Is Nothing Then Exit Sub  
Application.EnableEvents = False  
Columns(1).Interior.ColorIndex = xlNone  
With Target.Interior  
If .ColorIndex = xlNone Then .ColorIndex = 6  
End With  
Application.EnableEvents = True  
End Sub
 
 
 
#12
18.11.2011 19:37:54
благодарю, что откликнулись, но мне надо именно через мой код, мне просто нужна проверка столбцов  
можно ли реализовать это через мой код
 
 
 
#13
18.11.2011 19:47:41
lorents, Вы уже несколько раз приводите свой код, а нормально объяснить, что требуется, не можете. Попробуйте сформулировать свою "хотелку" заново. Например: Мне нужно в диапазоне ячеек (...) сделать так: ввожу данные, и, если эта ячейка была пустая и без заливки, то после ввода какого-либо значения нужно залить её жёлтым. Если я не так понял - поправьте меня. И почему Вы упёрлись в свой код? Зачем там переход по ошибке?  
P.S. И постарайтесь подписываться.
 
 
 
#14
18.11.2011 20:17:51
Мой код проверяет повторные ячейки в столбе, если повторные ячейки найдены, то он выделяет их желтым цветом, остальные ячейки делает без цветными. Суть в том, чтобы код не изменял цвет ячеек, которые заданы мною.
 
 
 
#15
18.11.2011 20:18:58
чтобы он проверял эти ячейки, но если цвет у ячейки задан, чтобы он его не изменял
 
 
 
#16
18.11.2011 20:41:45
{quote}{login=}{date=18.11.2011 08:17}{thema=}{post}Суть в том, чтобы код не изменял цвет ячеек, которые заданы мною.{/post}{/quote}Где Вы их задаёте?
 
 
 
#17
18.11.2011 20:44:29
Вручную добавляю цвет ячейки
 
 
 
#18
18.11.2011 20:56:47
Если правильно понял:  
Private Sub Worksheet_Change(ByVal Target As Range)  
Dim Rng As Range  
   Set Rng = UsedRange.Columns(Target.Column)  
   If Target.Interior.ColorIndex = xlNone Then  
       If Application.WorksheetFunction.CountIf(Rng, Target.Value) > 1 Then  
           Target.Interior.ColorIndex = 6  
       End If  
   End If  
End Sub
 
 
 
#19
18.11.2011 22:21:24
как-то код странно работает, то выделяет жельым цветом, то желтым цветом выделяет и не повторы.  
а почему нельзя сделать через тот код, который у меня?  мне просто интересно.
 
 
 
#20
18.11.2011 22:27:10
А кто это спрашивает? Вот я подписываюсь - Вам трудно?  
У меня (МОИ данные) выделяет только повторы. Не знаю, что за данные у Вас - я же не вижу.
 
 
 
#21
18.11.2011 22:33:40
Поясню логику работы моего кода (может быть я неправильно понимаю задачу):  
- установили диапазон - столбец активной ячейки в пределах используемого диапазона на листе.  
- проверяем: если ячейка без заливки,    
- если при этом число в ячейке в указанном диапазоне встречается более одного раза, то заливаем ячейку жёлтым.    
Такова задумка?
 
 
 
#22
18.11.2011 22:36:08
можно только сделать так, чтобы проверка была только в пределе того же столбца, и так по каждому столбцу?
 
 
 
#23
18.11.2011 22:38:04
{quote}{login=}{date=18.11.2011 10:36}{thema=}{post}можно только сделать так, чтобы проверка была только в пределе того же столбца, и так по каждому столбцу?{/post}{/quote}Так и сделано.
 
 
 
#24
18.11.2011 22:39:29
Повторюсь:  
{quote}{login=Юрий М}{date=18.11.2011 10:27}{thema=}{post}А кто это спрашивает? Вот я подписываюсь - Вам трудно?{/post}{/quote}
 
 
 
#25
18.11.2011 22:58:59
Вводил последовательно 1, 1, 2, 2, 3, 4  
и вот что получил
 
 
 
#26
18.11.2011 23:25:35
Действительно... Не понимаю, почему так происходит. Причём, если над "новой" ячейкой будет пустая строка - всё нормально. Странно ещё другое - ячейка красится ещё до... наступления события Change. Может кто-нибудь заглянет...
 
 
 
#27
18.11.2011 23:41:31
а почему нельзя просто использовать мой код?
 
 
 
#28
18.11.2011 23:42:08
усп простите, забваю вводить свой ник. Извените
 
 
 
#29
18.11.2011 23:47:06
Потому, что не вижу смысла перебирать ВСЕ ячейки в столбце, если нужно обработать только ОДНУ.
 
 
 
#30
19.11.2011 00:06:53
Мало того, что "до... наступления события Change", так вообще без макросов красится!
 
 
 
Страницы: 1 2 След.
Наверх