[發問] (已解決)VBA 特定符號及文字設定 程式請教

wind6424

想請教各位大大能幫忙看一下
下面VBA 那裡有問題,
   
我的目的是希望將儲存格中
[test1] 之前的文字變成藍色及字體加粗
然後每個[xxxx] 中括號內含括號及文字都設為黑色及加粗
其他的文字不變
這個程式在一開頭的文字是中文時執行都沒問題,
但是遇到開頭是英文或是數字時,
就會發生除了中括號內及文字是如設定的外
其它文字都變成藍色及加粗,
不知道是那裡還需要修改問題,
請各位前輩指導一下
謝謝

儲存格內容如下:
abscde
[test1]:
1.qwe
2.asd
[test2]:
qwe
[test3]:
sddf

VBA 程式:
With Sheet1.Cells(y, x)
        .Font.ColorIndex = 0
        .Font.Bold = False

        theText = .Text   'theText
  
        lngS = InStr(1, .Text, "[", 1) - 1
        
        .Characters(1, lngS).Font.ColorIndex = 5
        .Characters(1, lngS).Font.Bold = True
        
        Do While theText Like "*[[]*]*"
            
            lngS = InStr(lngS, .Text, "[")
               
            lngLen = VBA.InStr(lngS, .Text, "]") - lngS + 2
            
            .Characters(lngS, lngLen).Font.ColorIndex = 1
            .Characters(lngS, lngLen).Font.Bold = True
            
            lngS = lngS + lngLen
            theText = .Characters(lngS).Text

        Loop
   End With

GBKEE

回復 1# wind6424

1. Sub Ex()
   
2.     Dim Y, X, A, A1
   
3.     Y = 1: X = 1
   
4.     Do While Sheet1.Cells(Y, X) <> ""
   
5.         With Sheet1.Cells(Y, X)
   
6.             .Font.ColorIndex = 0
   
7.             .Font.Bold = False
   
8.             A = InStr(.Text, "[")
   
9.             A1 = InStr(.Text, "]")
   
10.             If A > 0 And A1 > 0 Then
    
11.                 .Characters(A, A1 - A + 1).Font.ColorIndex = 5
    
12.                 .Characters(A, A1 - A + 1).Font.Bold = True
    
13.             End If
    
14.             Y = Y + 1
    
15.         End With
    
16.    Loop
    
17. End Sub

複製代碼

Hsieh

1. Sub nn()
   
2. Dim A As Range, y%
   
3. For Each A In Range([A1], Cells(Rows.Count, 1).End(xlUp))
   
4. A.Font.Bold = False
   
5. A.Font.ColorIndex = 0
   
6. i = 1
   
7. Do Until Mid(A, i, 1) = "["
   
8.   With A.Characters(i, 1).Font
   
9.      .Bold = True
   
10.      .ColorIndex = 5
    
11.   End With
    
12.   i = i + 1
    
13. Loop
    
14. s = InStr(A, "[")
    
15. y = InStr(s, A, "]")
    
16. Do Until s = 0
    
17. A.Characters(s + 1, y - s - 1).Font.Bold = True
    
18. s = InStr(y, A, "[")
    
19. If s > 0 Then y = InStr(s, A, "]")
    
20. Loop
    
21. Next
    
22. End Sub

複製代碼

回復 1# wind6424

wind6424

感謝兩位板主的協助
將兩位的程式碼結合
改成如下,實驗了一下 ok 了
在來將Cells(6, 8) 這個修改一下,就可以一次處理多個欄位了
非常的感謝

1. Sub test()
   
2. Dim A As Range, y%
   
3. Dim s
   
4. 
   
5. For Each A In Cells(6, 8)
   
6. 
   
7. A.Font.Bold = False
   
8. A.Font.ColorIndex = 0
   
9. 
   
10. s = InStr(A, "[")
    
11. y = InStr(s, A, "]")
    
12. 
    
13. A.Characters(1, s-1).Font.ColorIndex = 5
    
14. A.Characters(1, s-1).Font.Bold = True
    
15. 
    
16. Do Until s = 0
    
17. A.Characters(s + 1, y - s - 1).Font.Bold = True
    
18. s = InStr(y, A, "[")
    
19. If s > 0 Then y = InStr(s, A, "]")
    
20. Loop
    
21. 
    
22. Next
    
23. 
    
24. End Sub

複製代碼

Hsieh

回復 4# wind6424

不對吧!
Cells(6,8)只針對H6此一儲存格

wind6424

回復  wind6424

不對吧!
Cells(6,8)只針對H6此一儲存格
Hsieh 發表於 2011-10-14 16:29

我是先使用兩位版大提供的程式碼,對一個欄位實驗看看,
所以取兩位的個人認為不錯的部份結合後,
在實驗看看沒問題後就貼上來了回覆了,
所以我知道這個是只針對H6 這個儲存格,
我知道還要在修改,
所以版大不好意思啦,讓您誤會了