Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Microsoft Office и VBA > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Ответ
 
Опции темы
Старый 02.12.2019, 09:27   #1
magistic
Пользователь
 
Регистрация: 06.12.2010
Сообщений: 15
По умолчанию Помощь в коде

Есть код он меняет чёрные буквы и первые цифры на красные, помогите мне нужно сделать на оборот!!! Файл в Екселе прилагаю пример.

Public Sub CharToRed(curSheetName As String, curCol As String, startRow As Integer)

Dim i As Integer
Dim j As Integer
Dim colIter As Integer
Dim str As String
Dim findSpace As Boolean

colIter = startRow

Do While Worksheets(curSheetName).Range(curC ol & colIter).Value <> ""

Worksheets(curSheetName).Range(curC ol & colIter).Value = Worksheets(curSheetName).Range(curC ol & colIter).Value

str = Worksheets(curSheetName).Range(curC ol & colIter).Value

findSpace = True

For i = 1 To Len(str)
If findSpace Then
findSpace = False
For j = 1 To 4
Worksheets(curSheetName).Range(curC ol & colIter).Characters(i, 1).Font.Color = RGB(234, 112, 13)
i = i + 1
If Mid(str, i, 1) = " " Then
Exit For
End If
Next j
End If

If Mid(str, i, 1) = " " Then
findSpace = True
End If

Next i

colIter = colIter + 1
Loop

Range("F9:F14").Select
Selection.Font.Bold = True


End Sub
Public Sub CharToRed1(curSheetName As String, curCol As String, startRow As Integer)

Dim i As Integer
Dim j As Integer
Dim colIter As Integer
Dim str As String
Dim findSpace As Boolean

colIter = startRow

Do While Worksheets(curSheetName).Range(curC ol & colIter).Value <> ""

Worksheets(curSheetName).Range(curC ol & colIter).Value = Worksheets(curSheetName).Range(curC ol & colIter).Value

str = Worksheets(curSheetName).Range(curC ol & colIter).Value

findSpace = True

For i = 1 To Len(str)
If findSpace Then
findSpace = False
For j = 1 To 4
Worksheets(curSheetName).Range(curC ol & colIter).Characters(i, 1).Font.Color = RGB(234, 112, 13)
i = i + 1
If Mid(str, i, 1) = " " Then
Exit For
End If
Next j
End If

If Mid(str, i, 1) = " " Then
findSpace = True
End If

Next i

colIter = colIter + 1
Loop

Range("F9:F14").Select
Selection.Font.Bold = True


End Sub
Вложения
Тип файла: xls Doc.xls (27.0 Кб, 4 просмотров)
magistic вне форума   Ответить с цитированием
Старый 02.12.2019, 10:41   #2
IgorGO
МегаМодератор
СуперМодератор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,251
По умолчанию

отметьте нужный диапазон
выполните 1 раз этот макрос
Код:
Sub ChangeColor()
  Dim rg As Range, c As Range, i&
  Set rg = Selection
  For Each c In rg
    For i = 1 To Len(c)
      c.Characters(i, 1).Font.Color = IIf(c.Characters(i, 1).Font.Color = 0, 255, 0)
    Next
  Next
End Sub
41001804815208 - Яндекс-деньги благодарности за удачные советы и решения можно отправлять прямо сюда)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума   Ответить с цитированием
Старый 03.12.2019, 02:39   #3
magistic
Пользователь
 
Регистрация: 06.12.2010
Сообщений: 15
По умолчанию

Спасибо Большое!
magistic вне форума   Ответить с цитированием
Ответ
Опции темы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужна помощь в коде sql Николай_S SQL, базы данных 0 09.10.2019 23:18
Нужна помощь в коде Javascript Oleg634 JavaScript, Ajax 1 22.02.2019 11:13
Помощь в коде С++, mid player Dima-91 Помощь студентам 0 17.11.2015 22:11
Помощь в коде С++, часы Dima-91 Помощь студентам 2 03.09.2015 19:58
Помощь в коде ассемблера+pascal X-Vlad Assembler - Ассемблер 2 02.12.2014 23:36