Excel中利用VBA实现批量设置文本的上标


Posted on January 13, 2018


 在Excel中设备上标较为简单,通过设备单元格属性即可完成,如下图:

但是如果量大,一个一个设置是不好弄的,结合网上找的内容,写了一段VBA如下:

 

Sub 批量设置上标()
'
' 批量设置上标 宏
'

    ' 复制值
    Dim line As Integer
    
    line = 0    '行号
    
    '行号自动获取, 以免新增行时忘记
    Dim r As Range
    For Each r In Range("A8:A1000")
        If r.Address < r.MergeArea.Address And r.Address = r.MergeArea.Item(1).Address Then
            line = r.Row - 1
            Exit For
        End If
    Next
    
    Range("Y8:Y" & line).Select
    Selection.Copy
    Range("D8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    '设备字体格式
    Range("D8:D" & line).Select
    With Selection.Font
        .Name = "宋体"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    
    '变上标
    Dim txtLength       As Long
    Dim i               As Long
    '循环设置
    For i = 8 To line
        
        '获取文本的长度
        txtLength = Cells(i, "D").Characters.Count
        
        '将最后一个文本设置为上标
        Cells(i, "D").Characters(txtLength, 1).Font.Superscript = True
        
    Next i
    
End Sub

参考网址:http://club.excelhome.net/thread-1247192-1-1.html


标签:N/A

 

在线学习答案查询入口
微信扫一扫
微信扫码联系