병합 된 셀의 특정 텍스트를 조건부로 서식 지정하는 VBA 스크립트

Question

Excel을 처음 사용하고 일부 셀을 조건부로 서식 지정하기 위해 VBA 스크립트를 작성하려고합니다.

저는 열이 있습니다. 각 개별 셀은 다음과 같습니다.

프로젝트 이름 : 이름 하나
AO : 두
BO 이름 : 세
CO 이름 : 네
할 이름 : 다섯 개

한 추가 세부 사항 이름이없는 모든 세포가 가지고 있다는 것입니다 다섯 줄 모두. 예를 들어 셀 만이있을 수 있습니다

AO : 두
BO 이름 : 이름을 세

내가 뭘해야 포맷하는 것입니다 그래서 프로젝트 명 :, AO :, BO : , CO : 및 DO : 모두 굵게 표시되며 Name One은 굵게, 기울임 꼴 및 색상으로 표시됩니다. 여기에 색상을 추가하는 방법을 말할 수는 없지만 이런 식으로 보일 것입니다.

프로젝트 이름 :
AO (색상)이름 하나 : 이름 두
BO : 이름 세
CO : 이름 네
할 : 이름 5

이 작업을 자동으로 수행하는 VBA 스크립트를 만드는 방법이 있는지 궁금합니다. 지난 몇 일간의 해결 방법은 각 셀의 텍스트를 개별적으로 선택하고 거기에 서식을 적용하는 것이 었습니다.

Excel 버전 : 2010

Answer 1

EDITED

서브 루틴이 쌍은 일을 할 것입니다. 서식을 한 번에 셀 범위에 적용 할 수 있습니다.

' Make a keyboard shortcut for this macro: 
Sub FormatActiveCells() 
    Dim c As Range 
    For Each c In Selection.Cells 
     FormatCell c 
    Next 
End Sub 

' This subroutine does the work 
Sub FormatCell(c As Range) 
    Dim pos1 As Integer, pos2 As Integer 
    ' Determine if line 1 is project name 
    pos1 = InStr(1, c.Text, "Project Name:") 
    If pos1 > 0 Then 
     ' Make "Project Name:" bold 
     c.Characters(pos1, Len("Project Name:")).Font.FontStyle = "Bold" 
     ' Advance past colon character 
     pos1 = pos1 + Len("Project Name:") 
     ' Find end-of-line character 
     pos2 = InStr(pos1, c.Text, Chr(10)) 
     ' Make text between "Project Name:" and end-line italicized and colored 
     c.Characters(pos1, pos2 - pos1).Font.FontStyle = "Bold Italic" 
     c.Characters(pos1, pos2 - pos1).Font.Color = RGB(0, 0, 255) 
     ' Point both positions to one character past end-of-line 
     pos2 = pos2 + 1 
     pos1 = pos2 
    Else 
     ' Point both positions to first character 
     pos1 = 1 
     pos2 = 1 
    End If 

    ' Format additional lines 
    Do 
     ' Find colon character 
     pos2 = InStr(pos1, c.Text, ":") 
     ' If not found, we're done 
     If pos2 = 0 Then Exit Do 
     ' Make text from start of line to colon bold 
     c.Characters(Start:=pos1, Length:=pos2 - pos1).Font.FontStyle = "Bold" 
     ' Find end-of-line 
     pos2 = InStr(pos2 + 1, c.Text, Chr(10)) 
     ' If not found, we're done 
     If pos2 = 0 Then Exit Do 
     ' Point both positions to one character past end-of-line 
     pos2 = pos2 + 1 
     pos1 = pos2 
     DoEvents 
    Loop 
End Sub