Как сделать так чтобы при копировании таблицы ,цифры меняли цвет,шрифт,жирность и подчёркивание в зависимости от интервала чисел. 70-79 менялся цвет,80-89 менялся цвет и жирность ,90-99 менялся шрифт и жирность,100 менялся шрифт ,жирность и подчёркивание.
Как сделать так чтобы при копировании таблицы ,цифры меняли цвет,шрифт,жирность и подчёркивание в зависимости от интервала чисел. 70-79 менялся цвет,80-89 менялся цвет и жирность ,90-99 менялся шрифт и жирность,100 менялся шрифт ,жирность и подчёркивание.Totalmen
Я имел ввиду при копировании ,то что бы не нужно изменять каждую ячейку отдельно,а что бы я скопированное вставил в определённый предел и программа автоматически выбрала и изменила .
Я имел ввиду при копировании ,то что бы не нужно изменять каждую ячейку отдельно,а что бы я скопированное вставил в определённый предел и программа автоматически выбрала и изменила .Totalmen
Sub TTT() Dim v&, g&, i&, i1& g = Cells(Rows.Count, 2).End(xlUp).Row v = Cells(1, Columns.Count).End(xlToLeft).Column For i = 1 To g For i1 = 2 To v If Cells(i, i1).Value >= 70 And Cells(i, i1).Value <= 79 Then Cells(i, i1).Select With Selection.Font .Color = -1003520 .Size = 11 End With ElseIf Cells(i, i1).Value >= 80 And Cells(i, i1).Value <= 89 Then Cells(i, i1).Select With Selection.Font .Color = -1003520 .FontStyle = "полужирный" .Size = 12 End With ElseIf Cells(i, i1).Value >= 90 And Cells(i, i1).Value <= 99 Then Cells(i, i1).Select With Selection.Font .Color = -1003520 .FontStyle = "полужирный" .Size = 14 End With ElseIf Cells(i, i1).Value = 100 Then Cells(i, i1).Select With Selection.Font .Color = -1003520 .FontStyle = "полужирный" .Size = 14 End With Selection.Font.Underline = xlUnderlineStyleSingle End If
Next i1 Next i
End Sub
[/vba]
Я малость потренировался . в файле нажмите кнопку
[vba]
Код
Sub TTT() Dim v&, g&, i&, i1& g = Cells(Rows.Count, 2).End(xlUp).Row v = Cells(1, Columns.Count).End(xlToLeft).Column For i = 1 To g For i1 = 2 To v If Cells(i, i1).Value >= 70 And Cells(i, i1).Value <= 79 Then Cells(i, i1).Select With Selection.Font .Color = -1003520 .Size = 11 End With ElseIf Cells(i, i1).Value >= 80 And Cells(i, i1).Value <= 89 Then Cells(i, i1).Select With Selection.Font .Color = -1003520 .FontStyle = "полужирный" .Size = 12 End With ElseIf Cells(i, i1).Value >= 90 And Cells(i, i1).Value <= 99 Then Cells(i, i1).Select With Selection.Font .Color = -1003520 .FontStyle = "полужирный" .Size = 14 End With ElseIf Cells(i, i1).Value = 100 Then Cells(i, i1).Select With Selection.Font .Color = -1003520 .FontStyle = "полужирный" .Size = 14 End With Selection.Font.Underline = xlUnderlineStyleSingle End If
китин, Приветствую) для тренировки поправил твой макрос (вдруг и тебе полезно будет) 1.Вариант используя Select Case
[vba]
Код
Sub TTT() Dim v&, g&, i&, i1& g = Cells(Rows.Count, 2).End(xlUp).Row v = Cells(1, Columns.Count).End(xlToLeft).Column For i = 1 To g For i1 = 2 To v Set rC = Cells(i, i1) With rC.Font Select Case rC.Value Case Is = 100 .Color = -1003520 .FontStyle = "полужирный" .Size = 14 .Underline = xlUnderlineStyleSingle Case Is >= 90 .Color = -1003520 .FontStyle = "полужирный" .Size = 14 Case Is >= 80 .Color = -1003520 .FontStyle = "полужирный" .Size = 12 Case Is >= 70 .Color = -1003520 .Size = 11 End Select End With Next i1 Next i End Sub
[/vba]
2. Вариант,на ветвлении If
[vba]
Код
Sub TTT1() Dim v&, g&, i&, i1& g = Cells(Rows.Count, 2).End(xlUp).Row v = Cells(1, Columns.Count).End(xlToLeft).Column For i = 1 To g For i1 = 2 To v Set rC = Cells(i, i1) With rC.Font If rC.Value >= 70 Then .Color = -1003520 .Size = 11 If rC.Value >= 80 Then .FontStyle = "полужирный" .Size = 12 If rC.Value >= 90 Then .Size = 14 If rC.Value = 100 Then .Underline = xlUnderlineStyleSingle End If End If End If End With Next i1 Next i End Sub
[/vba]
китин, Приветствую) для тренировки поправил твой макрос (вдруг и тебе полезно будет) 1.Вариант используя Select Case
[vba]
Код
Sub TTT() Dim v&, g&, i&, i1& g = Cells(Rows.Count, 2).End(xlUp).Row v = Cells(1, Columns.Count).End(xlToLeft).Column For i = 1 To g For i1 = 2 To v Set rC = Cells(i, i1) With rC.Font Select Case rC.Value Case Is = 100 .Color = -1003520 .FontStyle = "полужирный" .Size = 14 .Underline = xlUnderlineStyleSingle Case Is >= 90 .Color = -1003520 .FontStyle = "полужирный" .Size = 14 Case Is >= 80 .Color = -1003520 .FontStyle = "полужирный" .Size = 12 Case Is >= 70 .Color = -1003520 .Size = 11 End Select End With Next i1 Next i End Sub
[/vba]
2. Вариант,на ветвлении If
[vba]
Код
Sub TTT1() Dim v&, g&, i&, i1& g = Cells(Rows.Count, 2).End(xlUp).Row v = Cells(1, Columns.Count).End(xlToLeft).Column For i = 1 To g For i1 = 2 To v Set rC = Cells(i, i1) With rC.Font If rC.Value >= 70 Then .Color = -1003520 .Size = 11 If rC.Value >= 80 Then .FontStyle = "полужирный" .Size = 12 If rC.Value >= 90 Then .Size = 14 If rC.Value = 100 Then .Underline = xlUnderlineStyleSingle End If End If End If End With Next i1 Next i End Sub
sboy, Спасибо всё работает,в приложенном файле кнопка не работает,нужно заходить в настройки макроса и нажимать выполнить,а как сделать что бы кнопка заработала.
sboy, Спасибо всё работает,в приложенном файле кнопка не работает,нужно заходить в настройки макроса и нажимать выполнить,а как сделать что бы кнопка заработала.Totalmen
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
