Board logo

標題: [發問] 將儲存格內容多列資料拆解顯示 [打印本頁]
作者: fantersy    時間: 2018-10-17 20:55     標題: 將儲存格內容多列資料拆解顯示

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

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

[attach]29544[/attach]
[attach]29543[/attach]
作者: hcm19522    時間: 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)),)))
作者: ikboy    時間: 2018-10-18 12:44

VBA
  1. Sub zz()
  2. Dim ar, b, s$, k, t, m&, n&
  3. ar = Split([a2].Value, Chr(10))
  4. With CreateObject("vbscript.regexp")
  5.     For i = 0 To UBound(ar)
  6.         .Pattern = "[A-Z]+"
  7.         k = .Execute(ar(i))(0)
  8.         .Pattern = "\d+" & k
  9.         t = .Execute(ar(i))(0)
  10.         b = Split(Replace(.Replace(ar(i), ""), k, ""), "~")
  11.         n = 0
  12.         For j = b(0) To b(1)
  13.             s = s & "|" & t & j: n = n + 1: m = m + 1
  14.         Next
  15.     Next
  16.     [g3].Resize(m) = Application.Transpose(Split(Mid(s, 2), "|"))
  17. End With
  18. End Sub
複製代碼
作者: 准提部林    時間: 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
作者: fantersy    時間: 2018-10-18 20:37

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

謝謝大家!!
作者: fantersy    時間: 2018-10-20 12:01

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

想請問如果我要修改，是否用IF去判別就好
還是有其他方式
因為箱號旁要加上料號，所以小弟用了大大的程式修改了內容
還請參考附件~謝謝
  1. Sub TEST1()
  2. Dim Arr(1 To 20000, 0), Arr1(1 To 20000, 0), A, B, C, D, i&, N&, T$, TR
  3.     W = 1
  4. For Each A In Range([I2], [I65536].End(xlUp))
  5. W = W + 1
  6. For Each B In Split(A, Chr(10))
  7.    
  8.     T = Left(B, 8): TR = Split(Mid(B, 9), "~")
  9.     D = Cells(W, 3)
  10.     For i = Mid(TR(0), 2) To Mid(TR(1), 2)
  11.         N = N + 1: Arr(N, 0) = T & Left(TR(0), 1) & i
  12.         N = N + 0: Arr1(N, 0) = D
  13.     Next
  14. Next: Next
  15. [K3].Resize(N) = Arr
  16. [J3].Resize(N) = Arr1
  17. End Sub
複製代碼
[attach]29561[/attach]
作者: 准提部林    時間: 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 個



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