標題: [發問] 分離資料 [打印本頁]

---

作者: PJChen    時間: 2023-4-22 10:49     標題: 分離資料

大大好,

範例工作表中,A欄有中英or英數混合,A欄的列數會因客戶下單有增加or減少資料,所以沒有一定的列數,除了A欄,其餘欄位都可能會有公式存在.

請問如何分離A欄資料至X/Y欄,如範例所示?

[attach]36206[/attach]

---

作者: Andy2483    時間: 2023-4-25 10:23

回復 1# PJChen


    謝謝論壇,謝謝各位前輩,謝謝前輩發表此主題與範例
後學藉此帖練習VBA,學習方案如下,請前輩參考

執行前:
[attach]36215[/attach]

執行結果:
[attach]36216[/attach]

Option Explicit
Sub TEST()
Dim Brr, Crr, i&, Q$, X$, T$, P$, Jm%, j%, Y$
Brr = Range([A2], Cells(Rows.Count, "A").End(3))
ReDim Crr(1 To UBound(Brr), 1 To 2)
For i = 1 To UBound(Brr)
   Q = Trim(Brr(i, 1))
   For j = 1 To Len(Q)
      T = Mid(Q, j, 1)
      If T <> Evaluate("LeftB(""" & T & """,1)") Then Jm = Jm + 1: P = P & T
   Next
   P = Switch(Jm > 0, P, Q Like "[A-Z]*######GP##", Right(Q, 10), P = P, "")
   Y = IIf(P = "", "無", P): P = Replace(Q, P, "")
   X = IIf(P = "", "無", P): Crr(i, 1) = X: Crr(i, 2) = Y
   P = "": Jm = 0
Next
Intersect(ActiveSheet.UsedRange.Offset(1, 0), [X:Y]).ClearContents
[X2].Resize(UBound(Crr), 2) = Crr
Erase Brr, Crr
End Sub

---

作者: hcm19522    時間: 2023-4-25 14:25

D2:E5=TRIM(MID(REPLACE($B2,MIN(FIND(ROW($1:$10)-1,$B2&1/17)),,REPT(" ",99)),COLUMN(A1)*99-98,99))[img][/img]

---

作者: Andy2483    時間: 2023-4-26 10:04

回復 2# Andy2483


    謝謝論壇,謝謝各位前輩
後學複習這帖方案,學習心得註解如下,請各位前輩指教

Option Explicit
Sub TEST()
Dim Brr, Crr, i&, Q$, X$, T$, P$, Y$, Jm%, j%
'↑(Brr,Crr)是通用型變數,i是長整數,(Q,X,T,P,Y)是字串變數,(Jm,j)是短整數
Brr = Range([A2], Cells(Rows.Count, "A").End(3))
'↑令Brr這通用型變數是 二維陣列,以[A2]到A欄最後一個有內容儲存格值帶入
ReDim Crr(1 To UBound(Brr), 1 To 2)
'↑宣告Crr變數是二維陣列,縱向範圍從1到 Brr陣列縱向索引列號,
'橫向範圍從1到 2
For i = 1 To UBound(Brr)
'↑設順迴圈!i從1到 Brr陣列縱向索引列號
   Q = Trim(Brr(i, 1))
   '↑令Q這字串變數是 i迴圈列第1欄Brr陣列值去除頭尾空字元後的新字串
   For j = 1 To Len(Q)
   '↑設順迴圈!j從1到 Q字串字元數
      T = Mid(Q, j, 1)
      '↑令T這字串變數是Q變數取j變數開始的1個字
      If T <> Evaluate("LeftB(""" & T & """,1)") Then Jm = Jm + 1: P = P & T
      '↑如果T變數與 T變數取1個位元回傳值不相同!就令Jm這短整數累加1,
      '令P這字串變數是自身連接T變數所組成的新字串  (PS:國字是雙位元組成的字元)
   Next
   P = Switch(Jm > 0, P, Q Like "[A-Z]*######GP##", Right(Q, 10), P = P, "")
   '↑令P變數是Switch 函數回傳值,
   '如果有雙位元的字元,就回傳P是自身值
   '如果Q字串的組合是英文字開頭,再連接6個(含)以上數字字元,續連接"GP"字元,
   '最後連接兩個數字字元,就回傳P是Q字串的右邊10個字元
   '如果前面兩個判斷都不成立!就回傳P是空字元
   Y = IIf(P = "", "無", P): P = Replace(Q, P, "")
   '↑令Y這字串變數是IIf函數回傳值,
   '如果P變數是 空字元,就回傳Y是 "無"字元,否則就回傳Y是 P變數值,
   '令P變數是Q變數將所含的P變數值置換為空字元
   X = IIf(P = "", "無", P): Crr(i, 1) = X: Crr(i, 2) = Y
   '↑令X這字串變數是IIf函數回傳值,
   '如果P變數是 空字元,就回傳X是 "無"字元,否則就回傳X是 P變數值,
   '令i迴圈列第1欄Crr陣列值是 X變數值
   '令i迴圈列第2欄Crr陣列值是 Y變數值
   P = "": Jm = 0
   '↑令P變數是 空字元,令Jm變數歸零
Next
Intersect(ActiveSheet.UsedRange.Offset(1, 0), [X:Y]).ClearContents
'↑令兩區儲存格相交集的儲存格清除內容
'第一區:本表有使用的儲存格向下偏移一列的範圍儲存格
'另一區:本表的X:Y欄儲存格
[X2].Resize(UBound(Crr), 2) = Crr
'↑令[X2]擴展向下Crr陣列縱向最大索引列號,向右擴展2欄,
'這範圍儲存格值以Crr陣列值帶入
Erase Brr, Crr
'↑令釋放變數
End Sub

---

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