Board logo

標題: [發問] (已解決)VBA 特定符號及文字設定 程式請教 [打印本頁]
作者: wind6424    時間: 2011-10-14 14:08     標題: (已解決)VBA 特定符號及文字設定 程式請教

本帖最後由 wind6424 於 2011-10-14 16:32 編輯

想請教各位大大能幫忙看一下
下面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    時間: 2011-10-14 15:03

回復 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    時間: 2011-10-14 15:11

  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    時間: 2011-10-14 16:21

本帖最後由 wind6424 於 2011-10-14 16:29 編輯

感謝兩位板主的協助
將兩位的程式碼結合
改成如下,實驗了一下 ok 了
在來將Cells(6, 8) 這個修改一下,就可以一次處理多個欄位了
非常的感謝
  1. Sub test()
  2. Dim A As Range, y%
  3. Dim s

  5. For Each A In Cells(6, 8)

  7. A.Font.Bold = False
  8. A.Font.ColorIndex = 0

  10. s = InStr(A, "[")
  11. y = InStr(s, A, "]")

  13. A.Characters(1, s-1).Font.ColorIndex = 5
  14. A.Characters(1, s-1).Font.Bold = True

  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

  22. Next

  24. End Sub
複製代碼
作者: Hsieh    時間: 2011-10-14 16:29

回復 4# wind6424

不對吧!
Cells(6,8)只針對H6此一儲存格
作者: wind6424    時間: 2011-10-14 16:43

本帖最後由 wind6424 於 2011-10-14 16:46 編輯
回復  wind6424

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


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



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