Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

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

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

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 02.12.2019, 08: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, 09:41   #2
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

отметьте нужный диапазон
выполните 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
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 03.12.2019, 01:39   #3
magistic
Пользователь
 
Регистрация: 06.12.2010
Сообщений: 15
По умолчанию

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


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


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