- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
4#
發表於 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 |
|
