Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос, проверяющий цвет шрифта в ячейке
 
#1
12.07.2017 14:29:54
Добрый день! Написала макрос, он должен проверять цвет шрифта в ячейке и, если он красный, копировать данные из этой ячейки в другую на другом листе, потом возвращаться на первый лист и копировать данные из другой ячейки той же строки, снова вставлять их в ячейку на другом листе
Скопированные данные должны располагаться друг под другом
Код
Sub Macro()
Dim Ma As Integer
Dim Sa As Integer
Dim Ra As Integer
Dim Ga As Integer
 Ma = 30
For Sa = 5 To 102
    Cells(Sa, 22).Select
    If Cells(Sa, 22).Font.Color = 255 Then
   Ra = ActiveCell.Row
   Ga = ActiveCell.Column
     Selection.Copy
     Sheets("Сюда вставляем").Select
     Range("I & Ma : J & Ma").Select
     ActiveSheet.Paste
  Sheets("Это проверяем на красный шрифт").Select
  Range("B & Ra").Select
     Selection.Copy
     Sheets("Сюда вставляем").Select
     Range("B & Ma : H & Ma").Select
     ActiveSheet.Paste
  Cells(S, 22).Value = D + 1
  Ma = Ma + 1
  End If
Next
End Sub
Вот собственно сам макрос, но по каким то причинам эксель вроде бы выполняет его, а результат почему то не вижу. Подскажите, где ошибка?
Изменено: _Sonya_ - 12.07.2017 15:00:11
 
 
 
#2
12.07.2017 14:37:39
_Sonya_, код следует оформлять соответствующим тегом. Ищите такую кнопку и исправьте своё сообщение.
 
 
 
#3
12.07.2017 14:40:49
Вот такие "переменные" диапазоны Range("I & Ma : J & Ma")  записываются так: Range("I" & CStr(Ma) & ":J" & CStr(Ma))  
 
 
 
#4
12.07.2017 14:44:48
так? (зеленое можно удалить)
Код
Sub Macro()
Dim Ma As Integer
Dim Sa As Integer
'Dim Ra As Integer
'Dim Ga As Integer
 Ma = 30
With Sheets("Лист1 (2)")
For Sa = 5 To 102
    'Cells(Sa, 22).Select
If Cells(Sa, 22).Font.Color = vbRed Then
   'Ra = ActiveCell.Row' - Ra всегда равно Sa
   'Ga = ActiveCell.Column' - Ga всегда равно 22
     'Selection.Copy
     'Sheets("Лист1 (2)").Select
     Cells(Sa, 22).Copy .Range("I" & Ma & ":J" & Ma)
     'ActiveSheet.Paste
  'Sheets("Daily").Select
  Range("B" & Sa).Copy .Range("B" & Ma & ":H" & Ma)
  'Cells(S, 22).Value = D + 1' что такое S?
  Cells(Sa, 22).Value = D + 1 'скорее всего Sa
  Ma = Ma + 1
  End If
Next
End With
End Sub
Изменено: yozhik - 12.07.2017 14:45:05
 
 
 
#5
12.07.2017 14:48:24
yozhik, Ругается на седьмую строчку почему то
 
 
 
#6
12.07.2017 14:50:11
Впишите вместо "Лист1 (2)" имя листа, где проверяете шрифт на красный. Мы ж не видим Вашего файла - как там обозваны листы - поди знай.
Кому решение нужно - тот пример и рисует.
 
 
 
#7
12.07.2017 15:01:58
yozhik,Все, поняла, почему ругался, исправила, попробовала ваш код - то же самое, результата нет
 
 
 
#8
12.07.2017 15:05:09
Цитата
Пытливый написал:
Мы ж не видим Вашего файла
 
 
 
#9
12.07.2017 15:10:42
Цитата
_Sonya_ написал:
результата нет
может оно и цвет там не совсем красный) что вероятнее всего, т.к. Ваш макрос постоянно бы выдавал ошибки
попробуйте вместо
Код
If Cells(Sa, 22).Font.Color = vbRed Then
написать что-то вроде
Код
If Cells(Sa, 22).Font.Color > 200 And Cells(Sa, 22).Font.Color <= 255 Then
Изменено: yozhik - 12.07.2017 15:20:00
 
 
 
#10
12.07.2017 15:33:01
yozhik,так, хорошо, а если в таблице применен не красный шрифт, а, скажем, стиль "плохой", на что тогда изменить условие?
 
 
 
#11
12.07.2017 15:45:03
Код
If Cells(Sa, 22).Style = "Bad" Then
 
 
 
#12
12.07.2017 15:58:24
yozhik,Эх, все равно нет результата. Все равно, спасибо за помощь)
 
 
 
#13
12.07.2017 16:02:27
не уверен, но может в русско-язычной версии вместо "Bad" написать "Плохой"?) выделите любую чистую ячейку, включите макрорекодер и установите стиль плохой. Посмотрите что запишется
 
 
 
#14
19.08.2021 14:55:36
Такая же проблема. Оказалось, VBA не видит изменение цвета шрифта в результате применения условного форматирования. Можно это обойти?
 
 
 
#15
19.08.2021 15:21:38
Ilya66, перед .Interior.Color или .Font.Color надо вставлять .DisplayFormat чтобы получалось Cell().DisplayFormat.Font.Color
Изменено: Jack Famous - 19.08.2021 17:10:24
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#16
19.08.2021 15:49:00
.
 
 
 
#17
19.08.2021 16:04:32
RAN, на кибере говорили про 2007ой
убрал уточнение
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#18
19.08.2021 17:01:08
Jack Famous, спасибо! Работает!
 
 
 
#19
19.08.2021 17:49:05
Ilya66,
Файл приложите - быстрее получите ответ. И эти правки пробовали в свою формулу вносить?
 
 
 
#20
19.08.2021 18:02:42
Неопытный_Экселист, успокойтесь - ответ уже получен.
 
 
 
#21
19.08.2021 18:04:32
Неопытный_Экселист, зачем вы даёте советы абсолютно не разбираясь в вопросе?  :D
Файл здесь не нужен, а "правки", да и ВСЁ обсуждение выше никакой пользы для ТСа не несут. Хотя, как ни странно, вопрос по теме, хоть и немного про альтернативные свойства  :)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: 1
Читают тему
Наверх