Board logo

標題: [發問] 請問各位前輩關於VBA 中字串取代問題 [打印本頁]
作者: ii31sakura    時間: 2014-6-9 19:03     標題: 請問各位前輩關於VBA 中字串取代問題

各位前輩請問一下~如附件中小弟的B欄為清單來源、小弟想要整理將需要的項目另外整理出像"C" & "D"欄情況，
請問前輩們小弟該如何改寫才有辨法得出所需的答案呢？

再次麻煩大家了、謝謝~
[attach]18462[/attach]
作者: stillfish00    時間: 2014-6-9 20:07

本帖最後由 stillfish00 於 2014-6-9 20:11 編輯

回復 1# ii31sakura
  1. Sub TEST()
  2.   Dim ar, s, oReg
  3.   
  4.   Set oReg = CreateObject("vbscript.regexp")
  5.   With oReg
  6.     .Global = True
  7.     .Pattern = "(\d+)-(\S+).*\*(\d+)"
  8.   End With
  9.   With Worksheets("data")
  10.     ar = .Range(.[B2], .Cells(.Rows.Count, "B").End(xlUp)).Value
  11.     ReDim Preserve ar(1 To UBound(ar), 1 To 2)
  12.     For i = 1 To UBound(ar)
  13.       s = ar(i, 1)
  14.       ar(i, 1) = oReg.Replace(s, "$1-$3")
  15.       ar(i, 2) = oReg.Replace(s, "$1-$2")
  16.     Next
  17.     .[C2].Resize(UBound(ar), UBound(ar, 2)).Value = ar
  18.   End With
  19. End Sub
複製代碼
作者: ii31sakura    時間: 2014-6-10 08:55

回復 2# stillfish00

stillfish00前輩感謝幫忙~
小弟先收下後再來研究大大提供的程式使用方式、
在此再次感謝stillfish00前輩了~
作者: ii31sakura    時間: 2014-6-10 12:32

回復 2# stillfish00

stillfish00前輩、不好意思能不能請幫小弟看一下，
因小弟在執行過程中有碰到特殊字串會去自動組合成類似日期格式，
如"c"欄反黃情況、請問小弟要從哪如何更改呢？

請麻煩一下了~感謝前輩


[attach]18468[/attach]
作者: stillfish00    時間: 2014-6-10 15:22

回復 4# ii31sakura
可以先選C欄，右鍵儲存格格式改為文字再跑。
或是程式碼裡新增一行改格式
  1. Sub TEST()
  2.   Dim ar, s, oReg
  3.   
  4.   Set oReg = CreateObject("vbscript.regexp")
  5.   With oReg
  6.     .Global = True
  7.     .Pattern = "(\d+)-(\S+).*\*(\d+)"
  8.   End With
  9.   With Worksheets("data")
  10.     ar = .Range(.[B2], .Cells(.Rows.Count, "B").End(xlUp)).Value
  11.     ReDim Preserve ar(1 To UBound(ar), 1 To 2)
  12.     For i = 1 To UBound(ar)
  13.       s = ar(i, 1)
  14.       ar(i, 1) = oReg.Replace(s, "$1-$3")
  15.       ar(i, 2) = oReg.Replace(s, "$1-$2")
  16.     Next
  17.     With .[C2].Resize(UBound(ar), UBound(ar, 2))
  18.       .NumberFormatLocal = "@"  '儲存格格式改為文字
  19.       .Value = ar
  20.     End With
  21.   End With
  22. End Sub
複製代碼
作者: ii31sakura    時間: 2014-6-10 17:03

回復 5# stillfish00

感謝stillfish00前輩的指導、原來把它弄成文字就不會自動串接了啊，
感謝幫忙哦~
作者: ii31sakura    時間: 2014-6-19 23:06

回復 5# stillfish00

stillfish00前輩不好意思、請您指導一下小弟、原先的例子是從B欄位去拆成C與D欄的結果，小弟碰到另外一個例子是類似的情況、
但卻是從C欄與D欄去合成B欄的情況，能否請指導一下小弟前輩的例子程式如何改寫呢？
因小弟試了好幾天還是想不透如何倒推回去前輩的程式原理。

請麻煩前輩一下了~
作者: stillfish00    時間: 2014-6-20 15:14

本帖最後由 stillfish00 於 2014-6-20 15:16 編輯

回復 7# ii31sakura
  1. Sub TEST2()
  2.   Dim ar, ar1, ar2, i, j
  3.   
  4.   With Worksheets("data")
  5.     ar = .Range(.[C2], .Cells(.Rows.Count, "D").End(xlUp)).Value
  6.     For i = 1 To UBound(ar)
  7.       ar1 = Split(ar(i, 1), vbLf): ar2 = Split(ar(i, 2), vbLf)
  8.       If UBound(ar1) <> UBound(ar2) Then MsgBox "Error : 出現儲存格內行數不一致": End
  9.       For j = LBound(ar1) To UBound(ar1)
  10.         If Split(ar1(j), "-")(0) <> Split(ar2(j), "-")(0) Then MsgBox "Error : 出現編號不匹配": End
  11.         ar1(j) = ar2(j) & String(5, " ") & "損壞*" & Split(ar1(j), "-")(1)
  12.       Next
  13.       ar(i, 1) = Join(ar1, vbLf)
  14.     Next
  15.     ReDim Preserve ar(1 To UBound(ar), 1)
  16.     .[B2].Resize(UBound(ar)) = ar
  17.   End With
  18. End Sub
複製代碼
作者: ii31sakura    時間: 2014-6-20 17:16

回復 8# stillfish00

感謝stillfish00前輩~程式中裡面也有看到提供防呆確認，
很感謝前輩的熱心幫忙~
   謝謝~



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