如何用vba给单元格的部分字符添加下划线？

下划线是在字体中设置。

给单元格内容添加下划线，可以整体添加下划线也可以部分字符添加下划线。

整体添加下划线使用Range对象的Font属性设置，部分字符添加下划线使用Range对象的Characters属性返回部分字符对象，然后再用Font属性设置。

添加下划线通过设置Font对象的Underline属性。

通过上述知识，以下代码举例示范了如何添加A1单元格前3个字符的下划线：

Sub QQ1722187970()
    Const xlUnderlineStyleSingle = 2
    Const xlUnderlineStyleNone = -4142
    Const xlUnderlineStyleDouble = -4119
    Dim oRng As Range
    Set oRng = Excel.ActiveCell
    '添加整个单元格的下划线
    With oRng.Font
        '设置单下划线
        .Underline = xlUnderlineStyleSingle
        '设置双下划线
        .Underline = xlUnderlineStyleDouble
        '设置无下划线
        .Underline = xlUnderlineStyleNone
    End With
    '为前3个字符添加下划线
    With oRng.Characters(1, 3).Font
        .Underline = xlUnderlineStyleSingle
    End With
End Sub

当单元格中的多个部分字符有下划线时，为了返回所有的下划线开始字符和结束字符所在的位置，可以使用如下的代码：

Sub QQ1722187970()
    Const xlUnderlineStyleSingle = 2
    Const xlUnderlineStyleNone = -4142
    Const xlUnderlineStyleDouble = -4119
    '定义字典对象变量
    Dim oDic As Object
    '创建字典对象
    Set oDic = CreateObject("Scripting.Dictionary")
    oDic.RemoveAll
    Dim oFont1 As Font
    Dim oFont2 As Font
    Dim oRng As Range
    Set oRng = Excel.ActiveCell
    Dim n As Long
    With oRng
        '获取单元格字符长度
        sLen = .Characters.Count
        '遍历所有字符
        For j = 1 To sLen
            '存储所有字符的下划线状态
            With .Characters(j, 1).Font
                oDic.Add j, .Underline
            End With
        Next j
        arrItems = oDic.items
        '清空字典
        oDic.RemoveAll
        '存储所有的下划线的开始和终止字符位置
        For j = 0 To UBound(arrItems) - 1
             If arrItems(j) = xlUnderlineStyleNone And arrItems(j + 1) = xlUnderlineStyleSingle Then
                oDic.Add n, j + 2
            End If
            If arrItems(j + 1) = xlUnderlineStyleNone And arrItems(j) = xlUnderlineStyleSingle Then
                oDic.Item(n) = oDic.Item(n) & "-" & (j + 1)
                n = n + 1
            End If
        Next j
        '返回所有下划线的起始和终止字符位置数组，"开始-结束"的形式
        arrItems = oDic.items
        For j = 0 To UBound(arrItems)
            arrTemp = Split(arrItems(j), "-")
            '下划线开始字符的位置
            iStart = Val(arrTemp(0))
            '下划线结尾字符的位置
            iEnd = Val(arrTemp(1))
        Next j
    End With
    Set oDic = Nothing
End Sub