[發問] 請問可以利用vba來達到自動斷行的效果嗎?

棋語鳥鳴

例如:我在"B2"儲存格中輸入    "名稱1,名稱2,名稱3,名稱4,名稱5,名稱6,名稱7,名稱8,名稱9,名稱10,名稱11"
我想要以逗號為依據，當遇到第4個逗號後~下一個文字~自動跳到下一行(有如ALT+ENTER)，以上"B2"儲存格來說，
"B2"則變成:
名稱1,名稱2,名稱3,名稱4,
名稱5,名稱6,名稱7,名稱8,
名稱9,名稱10,名稱11
請問此巨集如何設??
另外請問如果儲存格中有斷行，要如何利用巨集恢復???

luhpro

回復 1# 棋語鳥鳴
若單純只是對儲存格內容做自動斷行處理那是做得到的.

但若想在輸入過程中就要處理的話,
我目前還沒試出方法,
所以就先提供一半的功能囉.
自動斷行-Ans.zip (11.88 KB)

自動斷行-Ans.xls
下載次數: 14

2011-10-1 10:07

棋語鳥鳴

回復 2# luhpro


    謝謝您這麼熱心的回覆~不過.....我想要的是~讓他斷行後~資料還是在"同一個"儲存格，而不是分開的!
而其資料~是全部輸入完再斷行即可!

luhpro

回復 3# 棋語鳥鳴
喔...
那就很簡單了, 只要有底下的程式就可其他的都可以拿掉了 :

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.   Dim sStr$
   
3.   Dim iI%
   
4.   Dim lJ As Long, lLen As Long
   
5.   
   
6. On Error GoTo ErrorHandler
   
7. 
   
8. Application.EnableEvents = False
   
9.   With Target
   
10.     sStr = .Value
    
11.     lLen = Len(sStr)
    
12.     iI = 0
    
13.     lJ = 1
    
14.     Do While lJ < lLen
    
15.       If Mid(sStr, lJ, 1) = "," Then iI = iI + 1
    
16.       If iI = 4 Then
    
17.         .Value = Left(sStr, lJ) & Chr(10) & Right(sStr, Len(sStr) - lJ)
    
18.         sStr = .Value
    
19.         lLen = Len(sStr)
    
20.         lJ = lJ + 1
    
21.         iI = 0
    
22.       End If
    
23.       lJ = lJ + 1
    
24.     Loop
    
25.   End With
    
26. Application.EnableEvents = True
    
27. Exit Sub
    
28. 
    
29. ErrorHandler:
    
30.     Select Case Err.Number
    
31.       Case 13 ' 刪除列會導致 Target 為 Null 此時引用 .Value 會發生錯誤
    
32.         sStr = ""
    
33.     End Select
    
34.     Resume Next
    
35. End Sub

複製代碼

棋語鳥鳴

回復 4# luhpro


  不好意思~如果我想以按鈕方式呈現(而不是去點擊)，且只想對某個範圍的儲存格(例如B2:B10)進行斷行，請問要如何修改此程序??

Hsieh

1. Sub 分行()
   
2. Dim A As Range, Ar()
   
3. For Each A In Selection
   
4.    mystr = A
   
5.    For i = 1 To Len(A)
   
6.    If Mid(A, i, 1) = "," Then s = s + 1
   
7.        If s Mod 4 = 0 And Mid(A, i, 1) = "," Then
   
8.         mystr = Application.WorksheetFunction.Replace(mystr, i, 1, Chr(10))
   
9.        End If
   
10.    Next
    
11.    A = mystr: s = 0
    
12. Next
    
13. End Sub
    
14. Sub 復原()
    
15. For Each A In Selection
    
16. A.Value = Replace(A, Chr(10), ",")
    
17. Next
    
18. End Sub

複製代碼

回復 5# 棋語鳥鳴

棋語鳥鳴

回復 6# Hsieh


    原來mid還有這種功能!感謝您的回覆!看來我要多學學函數加巨集的應用!