返回列表 上一主題 發帖

[發問] 請問各位前輩關於VBA 中字串取代問題

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
1# 跳轉到 »
發表於 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
複製代碼

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 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
複製代碼

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
3#
發表於 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
複製代碼

TOP

        靜思自在 : 人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。
返回列表 上一主題