VBA脚本有条件地格式化连续单元格中的特定文本

时间:2014-02-27 06:23:12

标签: excel vba excel-vba

我是Excel新手并尝试编写VBA脚本来有条件地格式化某些单元格。

我有A列,每个单独的单元格都是这样的。

  

项目名称:名称一   AO:名称二   BO:姓名三   CO:名称四   DO:名字五

一个额外的细节是,不是每个单元都有五行。例如,一个单元格可能只有:

  

AO:姓名二   BO:名字三

我需要做的是格式化它,以便项目名称:,AO:,BO:,CO:和DO:都是粗体,而名称一是粗体,斜体和彩色。我不知道如何在这里添加颜色,但它看起来像这样。

  

项目名称: 名称一(带颜色)
   AO:名称二    BO:名称三    CO:名称四    DO:名称五

我想知道是否有办法创建VBA脚本来自动执行此操作?过去几天我的解决方法是在每个单元格中单独选择文本并在那里应用格式,这一直是地狱!

Excel版本:2010

1 个答案:

答案 0 :(得分:0)

<强> 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