VBA宏可以在单元格范围内查找特定文本并将其设置为粗体

时间:2017-10-31 15:16:34

标签: excel vba excel-vba

我正在尝试开发一个宏来查找工作簿中所有工作表中的特定文本,并将文本设置为粗体样式。

以下是我目前的工作正常:

Sub Style_Worksheets()

Dim ws As Worksheet

For Each ws In Sheets
    ws.Activate

Dim sCellVal As String

sCellVal = Range("A1").Value
sCellVal = Range("A5").Value
sCellVal = Range("A7").Value
sCellVal = Range("B7").Value

If sCellVal Like "*Workflow Name:*" Or _
sCellVal Like "Events*" Or _
sCellVal Like "Event Name*" Or _
sCellVal Like "Tag File*" Then

Range("A1").Font.Bold = True
Range("A5").Font.Bold = True
Range("A7").Font.Bold = True
Range("B7").Font.Bold = True

End If
Next ws
End Sub

现在我遇到的问题是我有一个特定的文本,在一个工作表中是在单元格A16中,但在另一个工作表中是在A10中。

我有超过100个需要样式的工作表,特定文本位于每个工作表的不同单元格中。

我希望Macro能够在单元格A10和A16之间找到特定的文本,如果找到文本,我希望它将其粗体化。

我尝试将以下内容添加到相关位置:

sCellVal = Range("A10:A16").Value

sCellVal Like "Workflow Level Mappings*" Or _

Range("A10:A16").Font.Bold = True

......但没有快乐。

任何人都可以帮助我吗?

谢谢,

A

2 个答案:

答案 0 :(得分:6)

给它一个机会。经过全面测试。

Option Explicit

Sub Style_Worksheets()

    Dim TestPhrases() As String
    TestPhrases = Split("Workflow Name:,Events,Event Name,Tag File", ",")

    Dim ws As Worksheet

    For Each ws In Worksheets

        Dim CheckCell As Range
        For Each CheckCell In ws.Range("A10:A16")

            Dim Looper As Integer
            For Looper = LBound(TestPhrases) To UBound(TestPhrases)

                If InStr(CheckCell.Value, TestPhrases(Looper)) Then
                    CheckCell.Font.Bold = True
                    Exit For
                End If


            Next Looper

        Next CheckCell

    Next ws

End Sub

答案 1 :(得分:2)

只需循环查看相关单元格:

Sub Style_Worksheets()

    Dim ws As Worksheet, sCellVal As String
    Dim R As Range

    For Each ws In Sheets
        ws.Activate
        For Each R In Range("A1:A16")

            sCellVal = R.Text

            If sCellVal Like "*Workflow Name:*" Or _
                sCellVal Like "Events*" Or _
                sCellVal Like "Event Name*" Or _
                sCellVal Like "Tag File*" Then
                    R.Font.Bold = True
            End If
        Next R
    Next ws
End Sub