如何在Excel的范围或整个工作表中查找所有带下划线的文本？

Sub SearchForUnderline() Updateby20150910 Dim Rg As Range, Rg1 As Range Dim I As Long Dim xAddress As String, xAddress1 As String, xAddress2 As String Dim Result As String On Error Resume Next xAddress = Application.ActiveWindow.RangeSelection.Address Set Rg = Application.InputBox("Please select a range:", "Kutools for Excel", xAddress, , , , , 8) If Rg Is Nothing Then Exit Sub Set Rg = Application.Intersect(Rg, Application.ActiveSheet.UsedRange) If Rg Is Nothing Then Exit Sub Set Rg = Rg.SpecialCells(xlCellTypeConstants) If Rg Is Nothing Then Exit Sub For Each Rg1 In Rg For I = 1 To Len(Rg1) If Rg1.Characters(I, 1).Font.Underline = xlUnderlineStyleSingle Then If xAddress1 = "" Then xAddress1 = Rg1.Address Else xAddress1 = xAddress1 & ", " & Rg1.Address End If Exit For End If Next For I = 1 To Len(Rg1) If Rg1.Characters(I, 1).Font.Underline = xlUnderlineStyleDouble Then If xAddress2 = "" Then xAddress2 = Rg1.Address Else xAddress2 = xAddress2 & ", " & Rg1.Address End If Exit For End If Next Next If xAddress1 <> "" Then Result = "Single underline address:" & vbCr & xAddress1 & vbCr & vbCr If xAddress2 <> "" Then Result = Result & "Double underline address:" & vbCr & xAddress2 If Result <> "" Then MsgBox Result End Sub

Kutools for Excel, 与超过 300 方便的功能，使您的工作更加轻松。 

最佳办公生产力工具

在Word，Excel，PowerPoint中启用选项卡式编辑和阅读，发布者，Access，Visio和Project。 在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。 每天将您的工作效率提高50％，并减少数百次鼠标单击！