返回列表 上一主題 發帖

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

ii31sakura

帖子
43 
主題
13 
精華
0 
積分
75 
點名
0  
作業系統
windows 7 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2014-5-6 
最後登錄
2019-6-17 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2014-6-9 19:03 | 只看該作者

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

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

再次麻煩大家了、謝謝~
條件式取代 test.rar (11.61 KB)
收藏 分享

ii31sakura

帖子
43 
主題
13 
精華
0 
積分
75 
點名
0  
作業系統
windows 7 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2014-5-6 
最後登錄
2019-6-17 
9#
發表於 2014-6-20 17:16 | 只看該作者
回復 8# stillfish00

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

TOP

stillfish00

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

ii31sakura

帖子
43 
主題
13 
精華
0 
積分
75 
點名
0  
作業系統
windows 7 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2014-5-6 
最後登錄
2019-6-17 
7#
發表於 2014-6-19 23:06 | 只看該作者
回復 5# stillfish00

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

請麻煩前輩一下了~

TOP

ii31sakura

帖子
43 
主題
13 
精華
0 
積分
75 
點名
0  
作業系統
windows 7 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2014-5-6 
最後登錄
2019-6-17 
6#
發表於 2014-6-10 17:03 | 只看該作者
回復 5# stillfish00

感謝stillfish00前輩的指導、原來把它弄成文字就不會自動串接了啊，
感謝幫忙哦~

TOP

stillfish00

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

ii31sakura

帖子
43 
主題
13 
精華
0 
積分
75 
點名
0  
作業系統
windows 7 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2014-5-6 
最後登錄
2019-6-17 
4#
發表於 2014-6-10 12:32 | 只看該作者
回復 2# stillfish00

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

請麻煩一下了~感謝前輩


條件式取代 test1.rar (15.26 KB)

TOP

ii31sakura

帖子
43 
主題
13 
精華
0 
積分
75 
點名
0  
作業系統
windows 7 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2014-5-6 
最後登錄
2019-6-17 
3#
發表於 2014-6-10 08:55 | 只看該作者
回復 2# stillfish00

stillfish00前輩感謝幫忙~
小弟先收下後再來研究大大提供的程式使用方式、
在此再次感謝stillfish00前輩了~

TOP

stillfish00

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

        靜思自在 : 能幹不幹，不如苦幹實幹。
返回列表 上一主題