返回列表 上一主題 發帖

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

棋語鳥鳴

帖子
178 
主題
53 
精華
0 
積分
242 
點名
0  
作業系統
xp 
軟體版本
2007 
閱讀權限
20 
註冊時間
2011-2-22 
最後登錄
2024-7-5 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
2#
發表於 2011-10-1 10:08 | 只看該作者
回復 1# 棋語鳥鳴
若單純只是對儲存格內容做自動斷行處理那是做得到的.

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

TOP

棋語鳥鳴

帖子
178 
主題
53 
精華
0 
積分
242 
點名
0  
作業系統
xp 
軟體版本
2007 
閱讀權限
20 
註冊時間
2011-2-22 
最後登錄
2024-7-5 
3#
發表於 2011-10-1 12:43 | 只看該作者
回復 2# luhpro


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

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
4#
發表於 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
複製代碼

TOP

棋語鳥鳴

帖子
178 
主題
53 
精華
0 
積分
242 
點名
0  
作業系統
xp 
軟體版本
2007 
閱讀權限
20 
註冊時間
2011-2-22 
最後登錄
2024-7-5 
5#
發表於 2011-10-1 20:27 | 只看該作者
回復 4# luhpro


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

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
257  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-28 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 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# 棋語鳥鳴
學海無涯_不恥下問

TOP

棋語鳥鳴

帖子
178 
主題
53 
精華
0 
積分
242 
點名
0  
作業系統
xp 
軟體版本
2007 
閱讀權限
20 
註冊時間
2011-2-22 
最後登錄
2024-7-5 
7#
發表於 2011-10-2 10:25 | 只看該作者
回復 6# Hsieh


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

TOP

        靜思自在 : 原諒別人就是善待自己。
返回列表 上一主題