会excel-vba的朋友进，如何自动提取一堆数据中的加粗词语

首先，自定义一个函数，名称姑且为ExtrBold，代码如下：

Function ExtrBold(ByVal rng As Range)
    Dim i%, k%, Str$, St0$, St1$, Num0%, Num1%
    k = Len(rng)
    For i = 1 To k
        If rng.Characters(Start:=i, Length:=1).Font.FontStyle = "加粗" Then
            Str = Str & Mid(rng, i, 1)
        End If
    Next
    For j = 2 To Len(Str)
        St1 = Mid(Str, j, 1)
        St0 = Mid(Str, j - 1, 1)
        Num1 = Application.Find(St1, rng)
        Num0 = Application.Find(Mid(St0, 1), rng)
        If Num1 - Num0 > 1 Then
        ExtrBold = Replace(Str, St1, " " & St1)
        End If
    Next
End Function

－－－－－－－－－－－－－－－
函数说明：

该函数参数只有一个，就是对象单元格

－－－－－－－－－－－

运行效果：

 --------------------------

如果想分列，可以添加一个按钮，代码如下：

Private Sub CommandButton1_Click()
Dim arr, str$
For i = 1 To [a65536].End(3).Row
    str = ExtrBold(Cells(i, 1))
    arr = Split(str, " ")
    For j = 0 To UBound(arr)
        Cells(i, 2).Offset(, j) = arr(j)
    Next
Next
End Sub

---------------------------------

可以不用vba,用excel和word配合.点点鼠标就完成了

1 复制到word中

2 在word中替换(ctrl+h),查找格式字体常规,替换为空格

3 替换结果复制粘贴到excel中

4 分列>分隔符号空格

5 定位空值(ctrl+g)后删除单元格(ctrl+ -)

Sub s()
n = Cells(Rows.Count, 1).End(3).Row
For i = 1 To n
a = Cells(i, 1).Text
b = 2
c = ""
k = Len(a)
For j = 1 To k
If Cells(i, 1).Characters(j, 1).Font.Bold = True Then
c = c & Mid(a, j, 1)
If j = k Then Cells(i, b) = c
ElseIf c <> "" Then
Cells(i, b) = c
c = ""
b = b + 1
End If
Next
Next
End Sub