연결된 셀에서 특정 텍스트를 조건부로 포맷하는 VBA 스크립트

Question

나는 새로운 셀을 조건부로 서식으로 조건부로 포맷하기 위해 VBA 스크립트를 작성하려고 노력하고 있습니다.

나는 각 개별 셀이 이렇게 보이는 칼럼이있다.

프로젝트 이름 : 이름 하나
Ao : 이름 두 개
Bo : Name 3

CO : 이름 4
Do : Name 5

하나의 추가 세부 사항은 모든 세포가 모두 다섯 줄을 모두 갖는 것이 아닙니다. 예를 들어 셀만있을 수 있습니다 :

AO : 이름 둘
Bo : 3

의 이름

내가해야 할 일은 프로젝트 이름 :, ao :, bo :, co :, do : 이름 하나는 굵게, 기울임 꼴 및 착색 된 동안 모두 굵게 표시됩니다. 여기에 색을 추가하는 방법을 알 수 없지만 이와 같이 보입니다.

프로젝트 이름 : 이름 하나 (색상)
AO : 이름
보 : 이름 3
공동 : 이름 4
do : 이름 5

자동 으로이 작업을 수행하기 위해 VBA 스크립트를 만들 수있는 방법이 있는지 궁금합니다. 내 해결 방법 지난 며칠 동안 각 셀에서 텍스트를 개별적으로 선택하고 거기에서 형식을 적용하고 지옥이었습니다!

엑셀 버전 : 2010

Answer 1

편집

이 서브 루틴 쌍이 작업을 수행합니다.서식은 한 번에 한 번 셀 범위에 적용 할 수 있습니다.

' 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

.