Andy2483

回復 7# 准提部林


    謝謝論壇,謝謝前輩指導
後學藉此帖學習前輩的方案,執行結果與心得註解如下,請前輩再指導

執行前:

下載 (156.38 KB)

2023-11-9 09:14

執行結果:

下載 (257.17 KB)

2023-11-9 09:14

Sub 重整()
Dim Arr, Brr, A, B, xD, i&, N&, j%, T$
'↑宣告變數:(Arr,Brr,A,B,xD)是通用型變數,(i,N)是長整數,j是短整數,T是字串變數
[I2:L6000].Clear
'↑令[I2:L6000]這範圍儲存格清除
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD這通用型變數是 字典
Arr = Range([G2], [F65536].End(xlUp))
'↑令Arr這通用型變數是二維陣列,以[G2]到F欄最後有內容儲存格值帶入陣列中
For i = 1 To UBound(Arr)
'↑設順迴圈!令i從1 到Arr陣列縱向最大索引列號
    xD(Arr(i, 1) & "") = Arr(i, 2)
    '↑令i迴圈列1欄Arr陣列值(字串)當key,
    'item是 i迴圈列1欄Arr陣列值,納入xD字典中
Next i

Arr = Range([C2], [A65536].End(xlUp))
'↑令Arr陣列換裝盛 [C2]到A欄最後有內容儲存格 值
ReDim Brr(1 To 20000, 1 To 4)
'↑宣告Brr空陣列的範圍,縱向索引號1~20000,橫向1~4
For i = 1 To UBound(Arr)
'↑設順迴圈!令i從1 到Arr陣列縱向最大索引列號
    A = Split(Replace(Arr(i, 2), ChrW(160), ""), "、")
   '↑令A這通用型變數是 一維陣列:
    'i迴圈列2欄Arr陣列值經至換字元(空格>>空字元)成的新字串,再以"、"分割成的陣列
    https://learn.microsoft.com/zh-t ... haracter-set-128255
    B = Split(Replace(Arr(i, 3), ChrW(160), ""), "、")
    '↑令B這通用型變數是 一維陣列:
    'i迴圈列3欄Arr陣列值經至換字元(空格>>空字元)成的新字串,再以"、"分割成的陣列
    If UBound(A) <> UBound(B) Then MsgBox "第 " & i + 1 & " 行數據有問題!! ": Exit Sub
    '↑如果A陣列最大索引號與 如果B陣列最大索引號不同?
    'true就跳出提示窗~~~:結束程式執行
    For j = 0 To UBound(A)
    '↑設順迴圈!令j從1 到A陣列最大索引號
        N = N + 1:  T = T & "、" & xD(B(j) & "")
        '↑令N這長整數變數累加1
        '↑令T這字串變數是 自身連接 "、" 再連接(以j迴圈B陣列值字串查xD字典回傳值)
        Brr(N, 1) = Arr(i, 1):   Brr(N, 2) = A(j)
        '↑令N變數列1欄Brr陣列值是 i迴圈列1欄Arr陣列值
        '↑令N變數列2欄Brr陣列值是 j迴圈A陣列值
        Brr(N, 3) = B(j):   Brr(N, 4) = xD(B(j) & "")
        '↑令N變數列3欄Brr陣列值是 j迴圈B陣列值
        '↑令N變數列4欄Brr陣列值是 以j迴圈B陣列值字串查xD字典回傳值
    Next j
    Arr(i, 1) = Mid(T, 2): T = ""
    '↑令i迴圈列1欄Arr陣列值是 T變數去除第1個字元的新字串
    '令T變數字串清空
Next i

With [I2].Resize(N, 4)
'↑以下是關於[I2]擴展向下N變數列,擴展向右4欄儲存格範圍的程序
     .Columns(2).NumberFormatLocal = "#,##0 ;-#,##0 "
     '↑令這範圍儲存格第2欄格式要顯示千分位符號(,)
     .Columns(3).HorizontalAlignment = xlCenter
     '↑令這範圍儲存格第3欄儲存格值 水平對齊方式置中
     .Columns(4).NumberFormatLocal = "@"
     '↑令這範圍儲存格第4欄格式是文字
     .Borders.LineStyle = 1:  .Font.Size = 10
     '↑令這範圍儲存格框線是細實線
     '↑令這範圍儲存格文字大小為10
     .Value = Brr
     '↑令這範圍儲存格值以Brr陣列值帶入
End With

[D2].Resize(UBound(Arr)) = Arr '填入D欄對應值
'↑令[D2]擴展向下(Arr陣列最大索引號數列)儲存格範圍以Arr陣列值帶入
End Sub