ii31sakura

中學生 Rank: 2

帖子: 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)

樓主熱帖

stillfish00

大學生 Rank: 4

帖子: 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

Sub TEST()
Dim ar, s, oReg
Set oReg = CreateObject("vbscript.regexp")
With oReg
.Global = True
.Pattern = "(\d+)-(\S+).*\*(\d+)"
End With
With Worksheets("data")
ar = .Range(.[B2], .Cells(.Rows.Count, "B").End(xlUp)).Value
ReDim Preserve ar(1 To UBound(ar), 1 To 2)
For i = 1 To UBound(ar)
s = ar(i, 1)
ar(i, 1) = oReg.Replace(s, "$1-$3")
ar(i, 2) = oReg.Replace(s, "$1-$2")
Next
.[C2].Resize(UBound(ar), UBound(ar, 2)).Value = ar
End With
End Sub

複製代碼

TOP

ii31sakura

中學生 Rank: 2

帖子: 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

ii31sakura

中學生 Rank: 2

帖子: 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

stillfish00

大學生 Rank: 4

帖子: 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欄，右鍵儲存格格式改為文字再跑。
或是程式碼裡新增一行改格式

Sub TEST()
Dim ar, s, oReg
Set oReg = CreateObject("vbscript.regexp")
With oReg
.Global = True
.Pattern = "(\d+)-(\S+).*\*(\d+)"
End With
With Worksheets("data")
ar = .Range(.[B2], .Cells(.Rows.Count, "B").End(xlUp)).Value
ReDim Preserve ar(1 To UBound(ar), 1 To 2)
For i = 1 To UBound(ar)
s = ar(i, 1)
ar(i, 1) = oReg.Replace(s, "$1-$3")
ar(i, 2) = oReg.Replace(s, "$1-$2")
Next
With .[C2].Resize(UBound(ar), UBound(ar, 2))
.NumberFormatLocal = "@" '儲存格格式改為文字
.Value = ar
End With
End With
End Sub

複製代碼

TOP

ii31sakura

中學生 Rank: 2

帖子: 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

ii31sakura

中學生 Rank: 2

帖子: 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

stillfish00

大學生 Rank: 4

帖子: 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

Sub TEST2()
Dim ar, ar1, ar2, i, j
With Worksheets("data")
ar = .Range(.[C2], .Cells(.Rows.Count, "D").End(xlUp)).Value
For i = 1 To UBound(ar)
ar1 = Split(ar(i, 1), vbLf): ar2 = Split(ar(i, 2), vbLf)
If UBound(ar1) <> UBound(ar2) Then MsgBox "Error : 出現儲存格內行數不一致": End
For j = LBound(ar1) To UBound(ar1)
If Split(ar1(j), "-")(0) <> Split(ar2(j), "-")(0) Then MsgBox "Error : 出現編號不匹配": End
ar1(j) = ar2(j) & String(5, " ") & "損壞*" & Split(ar1(j), "-")(1)
Next
ar(i, 1) = Join(ar1, vbLf)
Next
ReDim Preserve ar(1 To UBound(ar), 1)
.[B2].Resize(UBound(ar)) = ar
End With
End Sub

複製代碼

TOP

ii31sakura

中學生 Rank: 2

帖子: 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