Board logo

標題: [發問] 請問可以利用vba來達到自動斷行的效果嗎? [打印本頁]
作者: 棋語鳥鳴    時間: 2011-9-30 22:07     標題: 請問可以利用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    時間: 2011-10-1 10:08

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

但若想在輸入過程中就要處理的話,
我目前還沒試出方法,
所以就先提供一半的功能囉.
[attach]8067[/attach]
作者: 棋語鳥鳴    時間: 2011-10-1 12:43

回復 2# luhpro


    謝謝您這麼熱心的回覆~不過.....我想要的是~讓他斷行後~資料還是在"同一個"儲存格，而不是分開的!
而其資料~是全部輸入完再斷行即可!
作者: luhpro    時間: 2011-10-1 16:55

本帖最後由 luhpro 於 2011-10-1 17:08 編輯

回復 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

  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

  29. ErrorHandler:
  30.     Select Case Err.Number
  31.       Case 13 ' 刪除列會導致 Target 為 Null 此時引用 .Value 會發生錯誤
  32.         sStr = ""
  33.     End Select
  34.     Resume Next
  35. End Sub
複製代碼
作者: 棋語鳥鳴    時間: 2011-10-1 20:27

回復 4# luhpro


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

  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# 棋語鳥鳴
作者: 棋語鳥鳴    時間: 2011-10-2 10:25

回復 6# Hsieh


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



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