- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
8#
發表於 2023-11-9 09:17
| 只看該作者
本帖最後由 Andy2483 於 2023-11-9 09:20 編輯
回復 7# 准提部林
謝謝論壇,謝謝前輩指導
後學藉此帖學習前輩的方案,執行結果與心得註解如下,請前輩再指導
執行前:
執行結果:
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 |
|
發表於 2018-11-29 13:39
| 
