- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-3-24
|
8#
發表於 2023-11-7 10:16
| 只看該作者
謝謝論壇,謝謝各位前輩
後學訂正複習心得註解如下,請各位前輩指教
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, Z, i&, R&, N&, j%, c%, T$, T2$, T3$, T4$
'↑宣告變數:(Arr,Brr,Crr,Z)是通用型變數,(i,R,N)是長整數變數,(j,c)是短整數變數,
'(T,T2,T3,T4)是字串變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z這通用型變數是 字典
c = Sheets(1).[IV1].End(xlToLeft).Column
'↑令c這短整數變數是 第1表第1列最右側有內容的索引欄號
Brr = Range(Sheets(1).Cells(1, c), Sheets(1).[A65536].End(3))
'↑令Brr這通用型變數是 二維陣列,以範圍儲存格值帶入:
'第1表c變數欄第1列儲存格到 第1表A欄最後有內容儲存格
Crr = Range(Sheets(2).[G1], Sheets(2).[A65536].End(3))
'↑令Crr這通用型變數是 二維陣列,以範圍儲存格值帶入:
'第2表[G1]儲存格到 第2表A欄最後有內容儲存格
ReDim Arr(1 To UBound(Crr), 1 To c)
'↑宣告Arr這通用型變數是 二維空陣列,縱向範圍索引號1到Crr陣列縱向最大索引列號,
'橫向範圍1到 c變數 索引欄號
For i = 2 To UBound(Brr): Z(Trim(Brr(i, 1)) & "/r") = i: Next
'↑設順迴圈!i從2 到Brr陣列縱向最大索引列號
'↑令i迴圈列1欄Brr陣列值去除頭尾空字元,連接"/r"組成的字串當key,
'item是i變數,納入Z字典中
For i = 2 To UBound(Crr)
'↑設順迴圈!i從2 到Crr陣列縱向最大索引列號
R = Z(Trim(Crr(i, 1)))
'↑令R這長整數變數是以 i迴圈列1欄Crr陣列值去除頭尾空字元 字串,
'查Z字典回傳Item值
If R = 0 Then N = N + 1: R = N: Arr(N, 1) = Crr(i, 1): Z(Trim(Crr(i, 1))) = R
'↑如果R變數是0!就令N這長整數累加1,令R變數同N變數值,
'令N變數列1欄Arr陣列值是 i迴圈列1欄Crr陣列值
'令i迴圈列1欄Crr陣列值去除頭尾空字元 字串當key,R變數值當item 納入Z字典裡
T = Trim(Crr(i, 7))
'↑令T這字串變數是 i迴圈列7欄Crr陣列值去除頭尾空字元 字串
For j = 2 To UBound(Brr, 2)
'↑設順迴圈!j從2 到Brr陣列橫向最大索引欄號
If Z(T & "/r") = "" Then Arr(R, j) = 0 Else Arr(R, j) = Arr(R, j) + Brr(Z(T & "/r"), j) * Val(Crr(i, 3))
'↑如果以T變數連接"/r"組成的新字串查Z字典回傳item是空字元,
'就令R變數列j變數欄Arr陣列值是0
'否則就令R變數列j變數欄Arr陣列值是 累加(Brr陣列值* i迴圈列3欄Crr陣列值)
'Brr陣列值:(T變數連接"/r"組成的新字串查Z字典回傳item)列,j變數欄Brr陣列值
Next
Next
If R = 0 Then MsgBox "沒有符合的資料": Exit Sub
'↑如果R變數是0!就跳出提視窗~~~,結束程式執行
With Sheets(3)
'↑以下是關於第3表的程序
T2 = .[A65536].End(3): T3 = Left(.[B1], 5)
'↑令T2這字串變數是A欄最後有內容儲存格字串
'↑令T3這字串變數是[B1]儲存格左側5個字元
T4 = .[A65536].End(3)(0): .UsedRange.Clear
'↑令T4這字串變數是 A欄最後有內容儲存格前一格字串
With .[A2].Resize(R, UBound(Arr, 2))
'↑以下是關於第3表[A2]擴展向下R變數列,擴展向右(Arr橫向最大索引欄號)欄,
'關於此範圍儲存格的程序
.Value = Arr: .Sort KEY1:=.Item(1), Order1:=1, Header:=2
'↑令此範圍儲存格值以Arr陣列帶入
'↑令此範圍儲存格做第1欄為基準的無標題漸增排序
End With
For j = 1 To c: Brr(1, j) = T3 & Brr(1, j): Next
'↑設順迴圈!j從1到c變數
'令第1列j迴圈欄Brr陣列值是 T3變數連接自身陣列值組合成的新字串
.[A1].Resize(1, c) = Brr: .[A1] = Sheets(2).[A1]
'↑令第3表[A1]擴展向右c變數欄範圍儲存格值 以Brr陣列值帶入
'↑令第3表[A1]儲存格值同 第2表[A1]儲存格值
.Cells(R + 2, 1) = T4: .Cells(R + 3, 1) = T2
'↑令第3表A欄(R變數+2)列儲存格是 T2變數
.Cells(R + 3, 2).Resize(1, c - 1).Value = "=SUM(B2:B" & R + 1 & ")"
'↑令第3表B欄(R變數+3)列儲存格擴展向右(c變數-1)欄範圍儲存格值是公式
'公式:SUM()加總 B2到B欄(R變數+1)列
'C~F欄公式會自動變化
Union(.[1:1], .Rows(R + 3)).Font.Bold = True: Application.Goto .[A1]
'↑令第1列與最後列儲存格字體為粗體
'↑令游標跳到第3表[A1]儲存格
End With
Set Z = Nothing: Erase Brr, Crr, Arr
'↑令釋放變數
End Sub |
|