подсветка латиницы и цифр (кирилицы и цифр)

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

подсветка латиницы и цифр (кирилицы и цифр) (Макросы/Sub)

ovechkin1973

Дата: Четверг, 20.02.2020, 10:31 | Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Приветствую. Пользуюсь макросом для подсветки Латиницы красным. Часто есть необходимость так же цифры подсвечивать этим же цветом. (макрос скопировал на Планета-эксель) Сам не смогу такую проблему решить.
[vba]

Код

Sub ShowLatin()
For Each c In Selection
    For i = 1 To Len(c)
        If (Asc(Mid(c, i, 1)) >= 65 And Asc(Mid(c, i, 1)) <= 90) Or _
               (Asc(Mid(c, i, 1)) >= 97 And Asc(Mid(c, i, 1)) <= 122) Then
                c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
        End If
    Next i
Next c
End Sub

[/vba]

И не могу найти аналогичный код для подсветки кирилицы, хотя ранее вроде на этом форуме находил

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

Nic70y

Дата: Четверг, 20.02.2020, 10:42 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 9005

Репутация: 2369 ±

Замечаний: 0% ±

Excel 2010

цифры
[vba]

Код

Sub ShowLatin()
For Each c In Selection
    For i = 1 To Len(c)
        If (Asc(Mid(c, i, 1)) >= 48 And Asc(Mid(c, i, 1)) <= 57) Then
            c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
        End If
    Next i
Next c
End Sub

[/vba]
кириллица
[vba]

Код

Sub ShowLatin()
For Each c In Selection
    For i = 1 To Len(c)
        If (Asc(Mid(c, i, 1)) >= 192 And Asc(Mid(c, i, 1)) <= 255) Or _
            Asc(Mid(c, i, 1)) = 184 Or Asc(Mid(c, i, 1)) = 168 Then
                c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
        End If
    Next i
Next c
End Sub

[/vba]

апдэйт

Цитата

хотя ранее вроде на этом форуме находил

тут видать

ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Четверг, 20.02.2020, 10:56

Ответить

ovechkin1973

Дата: Четверг, 20.02.2020, 12:10 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата Nic70y, 20.02.2020 в 10:42, в сообщении № 2 ()

цифры

Спасибо! Вопрос немного не по теме.. а если нужно только выделенные ячейки макросом обработать?

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

Nic70y

Дата: Четверг, 20.02.2020, 12:13 | Сообщение № 4

Группа: Друзья

Ранг: Экселист

Сообщений: 9005

Репутация: 2369 ±

Замечаний: 0% ±

Excel 2010

Цитата ovechkin1973, 20.02.2020 в 12:10, в сообщении № 3 ()

только выделенные ячейки

ну как бы он так и делает

Цитата ovechkin1973, 20.02.2020 в 10:31, в сообщении № 1 ()

For Each c In Selection

ЮMoney 41001841029809

Ответить

ovechkin1973

Дата: Четверг, 20.02.2020, 12:44 | Сообщение № 5

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата Nic70y, 20.02.2020 в 12:13, в сообщении № 4 ()

ну как бы он так и делает

Я отфильтровал нужные строки, после выделил ячейки в нужном столбце и макрос выделил красным даже скрытые ячейки. После пробовал выделенные ячейки через Найти и выделить - только видимые ячейки ... Тогда код, как надо отработал

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

Nic70y

Дата: Четверг, 20.02.2020, 14:10 | Сообщение № 6

Группа: Друзья

Ранг: Экселист

Сообщений: 9005

Репутация: 2369 ±

Замечаний: 0% ±

Excel 2010

Rows().RowHeight > 0
[vba]

Код

Sub ShowLatin()
For Each c In Selection
    For i = 1 To Len(c)
        If Rows(c).RowHeight > 0 And (Asc(Mid(c, i, 1)) >= 48 And Asc(Mid(c, i, 1)) <= 57) Then
            c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
        End If
    Next i
Next c
End Sub

[/vba]не будет красить скрытые/отфильтрованные

ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Четверг, 20.02.2020, 14:11

Ответить

ovechkin1973

Дата: Четверг, 20.02.2020, 21:34 | Сообщение № 7

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата Nic70y, 20.02.2020 в 14:10, в сообщении № 6 ()

Rows().RowHeight > 0

у меня ошибку выдает этот код. Run-time error 13
Type mismatch

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

Pelena

Дата: Четверг, 20.02.2020, 22:13 | Сообщение № 8

Группа: Админы

Ранг: Местный житель

Сообщений: 19405

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

[vba]

Код

c.Rows.RowHeight>0

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

ovechkin1973

Дата: Воскресенье, 23.02.2020, 09:24 | Сообщение № 9

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Nic70y, Pelena, спасибо за помощь! Работает, как надо.
[vba]

Код

Sub ВыделитьЛатиницуЦифрыКрасным()
For Each c In Selection
    For i = 1 To Len(c)
        If c.Rows.RowHeight > 0 And (Asc(Mid(c, i, 1)) >= 65 And Asc(Mid(c, i, 1)) <= 90) Or _
               (Asc(Mid(c, i, 1)) >= 97 And Asc(Mid(c, i, 1)) <= 122) Then
                c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
        End If
    Next i
Next c

For Each c In Selection
    For i = 1 To Len(c)
        If c.Rows.RowHeight > 0 And (Asc(Mid(c, i, 1)) >= 48 And Asc(Mid(c, i, 1)) <= 57) Then
            c.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
        End If
    Next i
Next c

End Sub

[/vba]

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

подсветка латиницы и цифр (кирилицы и цифр) (Макросы/Sub)

Страница 1 из 1
1