Excel / VBA计算字符串中粗体的单词数

I am desperately trying from yesterday to count how many words are bold in a cell.

我昨天拼命地试图计算一个单元格中有多少单词是粗体的。

Something like "foo foo foo" should give 1, "foo foo foo" should give 2.

像“foo foo foo”这样的东西应该给1，“foo foo foo”应该给2。

This is my best attempt, but it returns error or #VALUE:

这是我最好的尝试，但它返回错误或#VALUE：

Function CountBold(WorkRng As Range)

Dim Rng As Range
Dim xCount As Long
Dim i As Integer
Dim j As Long
Dim arText() As Variant

Rng = WorkRng.Cells(1, 1).Value

arText = Split(Rng.Value, " ")

For i = LBound(arText) To UBound(arText)

 j = InStr(0, Rng.Value, arText(i), 1)

 If j <> 0 Then If Rng.Characters(j, Len(arText(i))).Font.Bold Then xCount = xCount + 1

Next i

CountBold = xCount

End Function

Any help is very appreciated! Thank you in advance! Francesco

任何帮助非常感谢！先谢谢你！弗朗切斯科

2 个解决方案

#1

try this:

尝试这个：

Function CountBold(WorkRng As Range)

    Dim i, xcount As Integer
    For i = 1 To Len(WorkRng)

    If WorkRng.Characters(i, 1).Font.Bold = True Then
        xcount = xcount + 1
    End If

Next i

CountBold = xcount
End Function

#2

Update

Below function uses regular expressions.

下面的函数使用正则表达式

Function CountBold(WorkRng As Range) As Long
    Dim Rng As Range
    Dim sPattern As String
    Dim oRegExp As Object
    Dim oMatches As Object
    Dim oMatch As Object
    Dim Counter As Long

    Set Rng = WorkRng.Cells(1, 1)

    sPattern = "\w+" 'stands for at least one alphanumeric character or '_' character

    Set oRegExp = CreateObject("VBScript.RegExp")
    With oRegExp
        .Pattern = sPattern
        .Global = True
        Set oMatches = .Execute(Rng)
        For Each oMatch In oMatches
            If Rng.Characters(oMatch.FirstIndex + 1, oMatch.Length).Font.Bold Then Counter = Counter + 1
        Next
    End With

    CountBold = Counter
End Function