帖子: 132
主題: 35
精華: 0
積分: 179
點名: 0
作業系統: Windows
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2014-12-24
最後登錄: 2024-8-2

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2018-10-17 20:55 | 只看該作者

[發問] 將儲存格內容多列資料拆解顯示

各位大大好
小弟想了兩天一直想不出解答
論壇內也沒有相關的討論
故上來求解

如下圖所示
儲存格內有多列資料
但要將其拆解並在旁邊的欄位顯示
小弟的VBA功力不夠只會讀出儲存內內的內容並將其貼上
但不會拆解
若用函數也只會到縮排但沒有辦法拆解字串
所以想請問各位大大是否有方法可以解決~謝謝!!

出貨箱號.rar (9.08 KB)

樓主熱帖

hcm19522

大學生 Rank: 4

帖子: 1387
主題: 4
精華: 0
積分: 1397
點名: 0
作業系統: WIN
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2015-9-11
最後登錄: 2024-11-25

熱烈參與勳章

2^#

發表於 2018-10-18 11:17 | 只看該作者

A6:A9{=TRIM(MID(SUBSTITUTE(A$2,CHAR(10),REPT(" ",99)),ROW(A1)*99-98,99))

B6:B9{=IFERROR(SUM(LARGE(IF(ISERR(FIND(ROW($1:$99)&"~",A6&"~")),"",ROW($1:$99)),{1,2})*{1,-1})+1+N(B5),"")

G3 下拉{=IF(ROW(A1)>MAXA(B$6:B$9),"",LEFT(OFFSET(A$6,SUM(N(ROW(A1)>B$6:B$9)),),9)&MAX(ISNUMBER(FIND(ROW($1:$99)&"~",OFFSET(A$6,SUM(N(ROW(A1)>B$6:B$9)),)))*ROW($1:$99))+ROW(A1)-1-N(OFFSET(B$5,SUM(N(ROW(A1)>B$6:B$9)),)))

5133.png (17.49 KB)

google"EXCEL迷" blog 或google網址:https://hcm19522.blogspot.com/

TOP

ikboy

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 17
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2024-11-19

2016猴年全勤獎章

3^#

發表於 2018-10-18 12:44 | 只看該作者

VBA

Sub zz()
Dim ar, b, s$, k, t, m&, n&
ar = Split([a2].Value, Chr(10))
With CreateObject("vbscript.regexp")
For i = 0 To UBound(ar)
.Pattern = "[A-Z]+"
k = .Execute(ar(i))(0)
.Pattern = "\d+" & k
t = .Execute(ar(i))(0)
b = Split(Replace(.Replace(ar(i), ""), k, ""), "~")
n = 0
For j = b(0) To b(1)
s = s & "|" & t & j: n = n + 1: m = m + 1
Next
Next
[g3].Resize(m) = Application.Transpose(Split(Mid(s, 2), "|"))
End With
End Sub

複製代碼

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

4^#

發表於 2018-10-18 13:40 | 只看該作者

Sub TEST()
Dim Arr(1 To 20000, 0), A, B, C, i&, N&, T$, TR
For Each A In Range([A2], [A65536].End(xlUp))
For Each B In Split(A, Chr(10))
T = Left(B, 8): TR = Split(Mid(B, 9), "~")
For i = Mid(TR(0), 2) To Mid(TR(1), 2)
N = N + 1: Arr(N, 0) = T & Left(TR(0), 1) & i
Next
Next: Next
[F3].Resize(N) = Arr
End Sub

TOP

fantersy

中學生 Rank: 2

帖子: 132
主題: 35
精華: 0
積分: 179
點名: 0
作業系統: Windows
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2014-12-24
最後登錄: 2024-8-2

5^#

發表於 2018-10-18 20:37 | 只看該作者

謝謝各位高手的回覆!!小弟先試試!!有問題再麻煩各高手解惑!!

謝謝大家!!

TOP

fantersy

中學生 Rank: 2

帖子: 132
主題: 35
精華: 0
積分: 179
點名: 0
作業系統: Windows
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2014-12-24
最後登錄: 2024-8-2

6^#

發表於 2018-10-20 12:01 | 只看該作者

回復 4# 准提部林
請問准提部林大哥
目前測試下來
有一小問題想試問
如圖所示
[attach]29559[/attach]
當儲存格內容沒有"~"時程式會發生錯誤，下圖

想請問如果我要修改，是否用IF去判別就好
還是有其他方式
因為箱號旁要加上料號，所以小弟用了大大的程式修改了內容
還請參考附件~謝謝

Sub TEST1()
Dim Arr(1 To 20000, 0), Arr1(1 To 20000, 0), A, B, C, D, i&, N&, T$, TR
W = 1
For Each A In Range([I2], [I65536].End(xlUp))
W = W + 1
For Each B In Split(A, Chr(10))
T = Left(B, 8): TR = Split(Mid(B, 9), "~")
D = Cells(W, 3)
For i = Mid(TR(0), 2) To Mid(TR(1), 2)
N = N + 1: Arr(N, 0) = T & Left(TR(0), 1) & i
N = N + 0: Arr1(N, 0) = D
Next
Next: Next
[K3].Resize(N) = Arr
[J3].Resize(N) = Arr1
End Sub

複製代碼

test.zip (15.98 KB)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

7^#

發表於 2018-10-20 13:18 | 只看該作者

本帖最後由准提部林於 2018-10-20 13:20 編輯

沒有"~", 是否這樣 L180919-F25 , 只有起始號, 沒有結束號???

Sub TEST1()
Dim Arr(1 To 20000, 1), A, B, C, W&, D$, i&, N&, T$, TR
For Each A In Range([H2], [H65536].End(xlUp))
W = W + 1: D = Cells(W + 1, 2)
For Each B In Split(A, Chr(10))
T = Left(B, 8): TR = Split(Mid(B, 9) & "~" & Mid(B, 9), "~")
For i = Mid(TR(0), 2) To Mid(TR(1), 2)
N = N + 1: Arr(N, 0) = D: Arr(N, 1) = T & Left(TR(0), 1) & i
Next
Next: Next
[J:K].ClearContents
[J3:K3].Resize(N) = Arr
End Sub

Mid(B, 9) & "~" & Mid(B, 9) __
F25 變成 F25~F25
F1~F10 變成 F1~F10~F1~F10
SPLIT 就只取第 1 及第 2 個

TOP