VBA腳本有條件地設置級聯單元格中的特定文本

Question

我是Excel的新手，正在嘗試編寫VBA腳本以有條件地格式化某些單元格。

我有A列，每個單獨的單元格看起來像這樣。

項目名稱：一號
AO：第二名
BO：第三名
CO：姓名四
做：五名

一個額外的細節是，並非每個單元都具有全部五行。 例如，一個單元格可能只具有：

AO：第二名
BO：第三名

我需要做的是格式化它，以使Project Name :、 AO :、 BO :、 CO：和DO：都加粗，而Name One則加粗，斜體和上色。 我不能告訴您如何在此處添加顏色，但是看起來像這樣。

項目名稱： 一號（彩色）
AO：第二名
BO：第三名
CO：姓名四
做：五名

我想知道是否可以創建一個VBA腳本來自動執行此操作？ 過去幾天我的解決方法是分別在每個單元格中選擇文本並在那里應用格式，這真是太糟糕了！

Excel版本：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