麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] Office VBA，在範圍內搜尋有無刪除線並變色 [打印本頁]

作者: 蒼雪 時間: 2017-7-23 18:30 標題: Office VBA，在範圍內搜尋有無刪除線並變色

小弟，這樣寫之後，並沒有反應....
不知道是哪個環節出錯了，還請各位大大可以幫忙看一下。

搜尋特定範圍內是否有 "刪除線"，找到了就將儲存格變色

Sub test2()
With Worksheets(1).Range("a1:w100")
Set c = .Find(.Font.Strikethrough, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
c.Font.Color = rgbRed
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
End Sub

作者: joblyc017 時間: 2017-8-23 15:59

尋找功能，可搜尋具刪除線的儲存格

作者: 蒼雪 時間: 2017-8-29 10:12

回復 2# joblyc017

使用方面還滿不錯～
因為想達到，自動判別並變色。
所以後續找到下列方式︰

Sub test()
Dim c As Range, x As Long
For Each c In Range("o4:w181")
For x = Len(c.Value) To 1 Step -1
If c.Characters(x, 1).Font.Strikethrough Then
c.Interior.Color = rgbRed
Else
c.Interior.Color = rgbWhite
End If
Next
Next
End Sub

複製代碼

不過因為判別範圍較大的話，會造成lag...所以後續放棄... ...

作者: ML089 時間: 2017-8-30 00:00

回復 3# 蒼雪

貴式以最後一個字是否有刪除線決定反紅?

若是其中一字有刪除線就反紅，可參考如下
Sub test0()
Dim c As Range, x As Long, S%
For Each c In Range("a1:k30") 'Range("o4:w181")
      S = 0
      For x = Len(c.Value) To 1 Step -1
         If c.Characters(x, 1).Font.Strikethrough Then S = S + 1
      Next
      If S > 0 Then
         c.Interior.Color = rgbRed
      Else
         c.Interior.Color = rgbWhite
      End If
Next
End Sub

作者: 蒼雪 時間: 2017-8-31 21:48

回復 4# ML089

這個差別在哪邊呢？
試用後，判斷非常的迅速
S%的部份，以及後面的 S=S+1

抱歉，我處於初學部份，還需要大家的指導～

作者: ML089 時間: 2017-8-31 22:33

回復 5# 蒼雪

貴式判斷是由尾至頭每個判斷，所以最後第一個字變成控制是否要反紅的控制，
你可以測試刪除線是第二個字以後

作者: 蒼雪 時間: 2017-9-4 19:35

回復 6# ML089

抱歉，我想問的是

S%的部份是在處理文字需要第幾個？
若是判斷文字第2個，則改成 S=S+2，這樣嗎？
則 If S>0 改成 >1？

還麻煩你指導了，謝謝。

作者: ML089 時間: 2017-9-5 00:01

回復 7# 蒼雪

抱歉，我想問的是

S%的部份是在處理文字需要第幾個？
若是判斷文字第2個，則改成 S=S+2，這樣嗎？
則 If S>0 改成 >1？

S = S +1 , 累加計算一條文字中有幾個字有刪除線，
當S=0時表示沒有字沒有刪除線，若S>0表示一條文字中有幾個字有刪除線。

貴程式是檢查每個字就做一次文字反白反紅處理，所以處理比較久一點。

作者: 蒼雪 時間: 2017-9-5 18:08

回復 8# ML089

原來是這樣，謝謝指導～

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)