【20171114】- 批量為指定的內容添加下劃線
最近群里的小夥伴諮詢的問題都很有意思，所以都慢慢的拿出來和大家分享一下，這不群里有位哈爾濱的小夥伴問如何為指定的內容添加上下劃線，該小夥伴上傳的文件我已經放到了SUT學習交流群（群號：615356012）文件的【Q&A】中了，感興趣的小夥伴也可以嘗試解決哦。
下載【下劃線.xls】後，可以看到問題要求是，在給定的「某某工程」和「機械編碼鎖」上打下劃線。這個問題初看很容易，但如果「某某工程」後期變更為具體的工程後，也要可以批量實現添加下劃線。
為了讓代碼適用範圍更加廣泛，我對原有代碼進行了修改，最終可以達到如下效果，效果動態圖展示如下：
通過如上動態圖可以看到，點擊【下劃線 by Steven】按鈕後，會在「某某工程」等關鍵詞上加下劃線並標紅。點擊【清除下劃線】按鈕後，修改「某某工程」為「SUT事務所工程」後，點擊【下劃線 by Steven】按鈕，依舊能夠添加下劃線並標紅。
為了效果演示，我還在A6和A7單元格，添加了些許內容，並在段首和段尾同樣添加了下劃線和標紅。只有這樣，功能才更加強大，不局限於段落中的關鍵詞標紅。
其實該小夥伴的問題，可以拆解為兩部分，一是批量處理，可以使用For…Next或While循環來達到；二是為指定內容添加下劃線，雖說是指定內容，但可能內容後期會更改，所以可以理解為某些不會修改的關鍵字中間的內容添加上下劃線。同樣一個問題，換了一種問法，就更加容易解決了，所以懂得提問和解答一樣重要。帶著這兩個拆分步驟再去觀看代碼就很容易理解了，為了方便調用，把添加下劃線的功能單獨變為一個帶參數的宏，核心代碼如下：
Sub sutSetUnderline(rgSource As Range, strStart As String, strEnd As String)n Dim intStart, intEnd As Integern Dim intLength As Integern Dim strSource As Stringn strSource = rgSource.Valuen If InStr(strSource, strStart) > 0 Thenn intStart = InStr(strSource, strStart) + Len(strStart)n Elsen Exit Subn End Ifn If strEnd = "" Thenn intEnd = Len(strSource) + 1n Elsen intEnd = InStr(strSource, strEnd)n End Ifn If intStart >= 0 And intEnd > intStart Thenn intLength = intEnd - intStartn With rgSource.Characters(Start:=intStart, Length:=intLength).Fontn .Underline = xlUnderlineStyleSingle 下畫單線n .ColorIndex = 3 字體顏色紅色n End Withn End IfnEnd Subn
上面的宏代碼具有三個參數，第一個rgSource是需要加下劃線的單元格，strStart和strEnd是固定的關鍵詞，用來查找指定內容用的，具體代碼含義，大家可以使用F8單步調試。
附件我會上傳到QQ群文件中，供大家下載學習，如果在調試或使用過程中遇到任何問題，歡迎加群（QQ群：615356012）進行交流~~Written by Steven in 20171114^_^
微信公眾號：SaveUTime
SUT學習交流群：615356012，入群審核人：Steven
關注公眾號，提高效率，節約您的時間！
推薦閱讀：