Excel VBA를 사용하여 문자열의 단어를 기반으로 단어의 색을 변경 하시겠습니까?

Question

글꼴 색상을 단어로 쓰여진 색상을 반영하고 싶습니다. 예 : "red"라는 단어가 문자열에 나타날 때마다 red라는 단어의 글꼴을 빨간색으로 (또는 빨간색으로 강조 표시하기를) 원합니다. 사이트의 이름, 마감일 및 RAG 상태와 함께 셀에 텍스트 문자열이 있습니다. 이것들은 한 셀 안에 있고 줄 바꿈 (char (10))으로 구분됩니다. 마감일을 기준으로 한 셀 열과 작업 유형별 행이 있으므로 각 텍스트 세그먼트를 자체 셀로 쉽게 분할 할 수없고이 표 레이아웃을 깨지 않고 조건부 서식을 사용할 수 없습니다. 문자열은 텍스트를 연결 한 다음 수식에서 참조하는 코드로 작성됩니다. 기본 VBA를 작성할 수는 있지만 어떻게 할 수 있는지 알지 못했지만 텍스트 문자열 작성 방법을 설명하기 위해 Chandoo의 concat 코드를 첨부했습니다.

Function concat(useThis As Range, Optional delim As String) As String 
' this function will concatenate a range of cells and return one string 
' useful when you have a rather large range of cells that you need to add up 
For Each cell In useThis 
If CStr(cell.Value) <> "" And CStr(cell.Value) <> " " Then 
retVal = retVal & CStr(cell.Value) & dlm 
End If 
Next 
If dlm <> "" Then 
retVal = Left(retVal, Len(retVal) - Len(dlm)) 
End If 
concat = retVal 
End Function 

아무도 내가 이걸 어떻게 접근해야하는지 조언 해 줄 수 있습니까? 또는이 접근법에 대한 대안을 제안하십시오.

Answer 1

첫째, 당신은 색상을 변경하는 데 사용할 지정된 셀 내, 그래서

startRed = InStr(0,searchstring,"Red",CompareMethod.Text) 

다음, 문자열 내에서 검색 용어의 시작 위치를 찾기 위해 문자 속성 및 알려진 길이를 필요

With Cell.Characters(Start:= startRed, Length:= Len("Red")).Font 
    .Color = RGB(255,0,0) 

각각 원하는 색상과 당신의 세포에 대해이 작업을 수행 필요

Answer 2

감사 RGA로 변경됩니다. 나는 당신이 쓴 것을 아래에 쓰려고 사용했습니다. 가장 깔끔한 것은 아니지만 텍스트에 해당하는 색상을 사용하여 시트의 각 라인을 색칠 할 수 있습니다. 내 공식을 값으로 변환해야했습니다. 다시 한 번 감사드립니다. 나는 당신없이 시작해야 할 단서가 없었을 것입니다.

Sub ColourText2() 

TurnOff 
Dim startRed As Integer, startChar As Integer, startAmber As Integer, startGreen As Integer, x As Integer, i As Integer, startLB As Integer, endLB As  Integer, iCount As Integer 
Dim searchString As String, searchChar As String 
Dim clr As Long 
Dim cell As Range 


For x = 6 To 22 
iCount = Worksheets("MySheet").Range("D" & x & ":S" & x).Count 

Range("C" & x).Select 
Application.CutCopyMode = False 
Selection.AutoFill Destination:=Range("C" & x & ":S" & x), Type:=xlFillDefault 
Range("C" & x & ":S" & x).Select 
Worksheets("MySheet").Calculate 
Range("D" & x & ":S" & x).Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 

For Each cell In Worksheets("MySheet").Range("D" & x & ":S" & x) 
searchString = cell 


Application.StatusBar = i & "of: " & iCount 
startChar = 1 
    For startLB = 1 To Len(cell) 

cell.Select 
     If startChar = 1 Then 
      startLB = 1 
      endLB = 1 
     Else 
      startLB = InStr(endLB, searchString, Chr(10), vbTextCompare) 
     End If 

     startGreen = InStr(endLB, searchString, "green", vbTextCompare) 
      'MsgBox startGreen 
     startAmber = InStr(endLB, searchString, "amber", vbTextCompare) 
      'MsgBox startAmber 
     startRed = InStr(endLB, searchString, "red", vbTextCompare) 
      'MsgBox startRed 
     endLB = InStr(endLB + 1, searchString, Chr(10), vbTextCompare) 

     If startGreen < endLB And startGreen <> 0 Then 
      startChar = startGreen 
      cell.Characters(startLB, endLB - startLB).Font.Color = RGB(0, 153, 0) 
     ElseIf startAmber < endLB And startAmber <> 0 Then 
      startChar = startAmber 
      cell.Characters(startLB, endLB - startLB).Font.Color = RGB(226, 107, 10) 
      cell.Characters(startLB, endLB - startLB).Font.Underline = xlUnderlineStyleSingle 
     ElseIf startRed < endLB And startRed <> 0 Then 
      startChar = startRed 
      cell.Characters(startLB, endLB - startLB).Font.Color = RGB(255, 0, 0) 
      cell.Characters(startLB, endLB - startLB).Font.Underline = xlUnderlineStyleSingle 
      Else 
      GoTo MoveOn 
     End If 

     If startChar = 0 Then GoTo MoveOn  




MoveOn: 
Next 



Next cell 
x = x + 1 
Next 

TurnON 
Application.StatusBar = False 

MsgBox "finished" 
End Sub