Excel在文本中提取粗体字

时间:2017-09-25 11:18:36

标签: excel vba filter

任何人都可以帮我解决我的Excel问题吗? 我有一个充满文字的单元格。本文的某些单词以粗体显示。这些单词是关键字,应该被排除到行中的另一个单元格以识别关键字。 例如:

  

单元格中的文字:

     

我想将 Google 地图用于路线信息

     

输出:

     

谷歌;地图;路线;

提前谢谢!

2 个答案:

答案 0 :(得分:3)

试试这个

Option Explicit

Sub Demo()

    Dim ws As Worksheet
    Dim str As String, strBold As String
    Dim isBold As Boolean
    Dim cel As Range
    Dim lastRow As Long, i As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")    'change Sheet1 to your data sheet
    isBold = False

    With ws
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row    'last row with data in Column A
        For Each cel In .Range("A1:A" & lastRow).Cells      'loop through each cell in Column A
            strBold = ""
            For i = 1 To Len(cel.Value)
                If cel.Characters(Start:=i, Length:=1).Font.Bold = True Then 'check if character is bold
                    isBold = True
                    str = Mid(cel.Value, i, 1)
                    If cel.Characters(Start:=i, Length:=1).Text = " " Then  'check for space
                        strBold = strBold & "; "
                        isBold = False
                    Else
                        strBold = strBold & str
                    End If

                Else
                    If isBold Then
                        strBold = strBold & "; "
                        isBold = False
                    End If
                End If
            Next
            cel.Offset(0, 1) = strBold
        Next
    End With
End Sub

enter image description here

here派生此代码。

答案 1 :(得分:3)

您也可以使用此UDF生成相同的结果。请在模块中输入以下代码。

 Public Function findAllBold(ByVal rngText As Range) As String
    Dim theCell As Range
    Set theCell = rngText.Cells(1, 1)

    For i = 1 To Len(theCell.Value)       
        If theCell.Characters(i, 1).Font.Bold = True Then          
            If theCell.Characters(i + 1, 1).Text = " " Then
                theChar = theCell.Characters(i, 1).Text & ", "
                Else
                theChar = theCell.Characters(i, 1).Text
            End If
            Results = Results & theChar
        End If
   Next i
   findAllBold = Results
End Function

现在您可以使用新创建的函数从任何单元格返回粗体值。

enter image description here