Andy2483

回復 1# dou10801
回復 3# 准提部林


    謝謝 dou10801前輩發表此主題與範例
謝謝 准提部林前輩指導
以下是後學學習學心得註解,請前輩再指導

Sub 載入()
Dim Arr, Brr, xD, T$, R&, N&, i&, j%, S As Worksheet
'↑宣告變數:(Arr, Brr, xD)是通用型變數,T是字串變數,(R,N,i)是長整數
'j是短整數,S是工作表變數
ReDim Brr(1 To 30000, 1 To 14)
'↑宣告Brr變數是二維陣列,縱向範圍從索引號1到30000,橫向範圍從1索引號到14
Call 清除
'↑令執行副程式 Sub 清除()
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典
For Each S In Sheets
'↑設逐項迴圈!令S變數是活頁簿裡的工作表
    If S.Name = "匯總" Then GoTo s01
    '↑如果S變數工作表名字是 "匯總" ,就跳到標示 s01 位置繼續執行
    Arr = Range(S.[n1], S.[a65536].End(3))
    '↑令Arr變數是二維陣列,以S變數工作表的[N1]到A欄最後有內容儲存格,
    '令這儲存格範圍值帶入Arr陣列中
    For i = 5 To UBound(Arr)
    '↑設順迴圈從5 到Arr陣列最大索引列號
        T = Arr(i, 1): R = xD(T)
        '↑令T這字串變數是i迴圈列第1欄Arr陣列值
        '令R這長整數變數是以T變數查xD字典item值(此key所在的Brr陣列列號)
        If R = 0 Then
        '↑如果R變數值是0 (代表此key首次納入xD字典中)
           N = N + 1: R = N: xD(T) = N
           '↑令N這長整數變數累加1 (這是要記錄Brr陣列用到了第幾列)
           '令R變數值 = N變數值(意思是此key要放在Brr的N變數列)
           '令xD字典中T變數key的item值換成N變數值(這是要記錄此key在Brr的列號)
           Brr(N, 1) = T: Brr(N, 2) = Arr(i, 2)
           '↑令N變數列第1欄Brr陣列值是T變數
        End If
        For j = 3 To UBound(Arr, 2)
        '↑設順迴圈從3 到Arr陣列最大索引欄號
            Brr(R, j) = Brr(R, j) + Val(Arr(i, j))
            '↑令R變數列j迴圈欄Brr陣列值 累加Val函數值(i迴圈列j迴圈欄Arr陣列值)
        Next j
    Next i
s01: Next
'------------------------------
With Sheets("匯總").[a5].Resize(N, 14)
'↑以下是關於工作表"匯總" 的[A5]儲存格向下擴展N變數列,向右擴展14欄的儲存格範圍程序
     .Value = Brr
     '↑令該範圍儲存格值以Brr陣列值帶入
     .Columns(7) = "=rank(f5," & .Columns(6).Address & ")"
     '↑令第7欄值是 第6欄的排名
     .Columns(14) = "=rank(M5," & .Columns(13).Address & ")"
     '↑令第14欄值是 第13欄的排名
End With
End Sub

Sub 清除()
Sheets("匯總").UsedRange.Offset(4).ClearContents
'↑令"匯總" 工作表有使用的儲存格向下偏移4列的範圍儲存格清除內容
End Sub

Andy2483

謝謝論壇,謝謝各位前輩
以下是以 准提部林前輩的範例模擬不同情境需求,改以字典中的一維陣列方式的練習,請各位前輩指教

相同的執行結果:

下載 (192.71 KB)

2023-10-14 10:04

Option Explicit
Sub 載入_1()
Dim Arr, Brr(1 To 14), Z, A, T$, N&, i&, j%, q%
Sheets("匯總").UsedRange.Offset(4).ClearContents
Set Z = CreateObject("Scripting.Dictionary")
For q = 1 To Sheets.Count
   If Trim(Sheets(q).[A5]) = "" Then GoTo q01
   Arr = Range(Sheets(q).[n1], Sheets(q).[a65536].End(3))
   For i = 5 To UBound(Arr)
      T = Trim(Arr(i, 1)) & "|" & Trim(Arr(i, 2))
      A = Z(T)
      If Not IsArray(A) Then
         A = Brr
         A(1) = Trim(Arr(i, 1)): A(2) = Arr(i, 2)
      End If
      For j = 3 To UBound(Arr, 2)
         A(j) = A(j) + Val(Arr(i, j))
      Next
      Z(T) = A
   Next
q01: Next
'------------------------------
With Sheets("匯總").[A5].Resize(Z.Count, 14)
   .Value = Application.Transpose(Application.Transpose(Z.Items))
   .Sort KEY1:=.Item(1), Order1:=1, KEY2:=.Item(2), Order1:=1, Header:=2
   .Columns(7) = "=rank(F5," & .Columns(6).Address(1, 1) & ")"
   .Columns(14) = "=rank(M5," & .Columns(13).Address(1, 1) & ")"
End With
End Sub

Andy2483

回復 6# Andy2483


    以下是複習心得註解

Option Explicit
Sub 載入_1()
Dim Arr, Brr(1 To 14), Z, A, T$, i&, j%, q%
'↑宣告變數:(Arr,Z,A)是通用型變數,T是字串變數,(i)是長整數
'(j,q)是短整數,Brr是一維空陣列,索引號1~14
Sheets("匯總").UsedRange.Offset(4).ClearContents
'↑令"匯總"工作表中涵蓋已使用儲存格的最小方正區域儲存格範圍,
'此範圍向下偏移4列的新範圍清除內容
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z這通用型變數是 字典
For q = 1 To Sheets.Count
'↑設順迴圈!令q這短整數從1 到這活頁簿的工作表數量數
   If Trim(Sheets(q).[A5]) = "" Then GoTo q01
   '↑如果q迴圈數工作表的[A5]儲存格值去除頭尾空字元後的新字串是空字元,
   '如果是空字元就跳到標示 q01位置繼續執行
   Arr = Range(Sheets(q).[n1], Sheets(q).[a65536].End(3))
   '↑令Arr這通用型變數是二維陣列,以q迴圈索引號工作表的[N1]到A欄最後有內容儲存格,
   '令這儲存格範圍值帶入Arr陣列中
   For i = 5 To UBound(Arr)
   '↑設順迴圈!令i變數從1到 Arr陣列縱向最大索引列號
      T = Trim(Arr(i, 1)) & "|" & Trim(Arr(i, 2))
      '↑令T這字串變數是 以"|"符號連接i列1/2欄Arr陣列值去除頭尾空白字元的組合新字串
      A = Z(T)
      '↑令A這通用型變數是 以T變數查Z字典帶出來的item
      If Not IsArray(A) Then
      '↑如果A變數不是陣列??
         A = Brr
         '↑令A變數是 同Brr陣列大小的一維空陣列
         A(1) = Trim(Arr(i, 1)): A(2) = Trim(Arr(i, 2))
         '↑令A陣列1索引號陣列值是 i迴圈列1欄Arr陣列值,去除頭尾空白字元的新字串
         '↑令A陣列2索引號陣列值是 i迴圈列2欄Arr陣列值,去除頭尾空白字元的新字串
      End If
      For j = 3 To UBound(Arr, 2)
      '↑設順迴圈!令j變數從3到 Arr陣列橫向最大索引欄號數
         A(j) = A(j) + Val(Arr(i, j))
         '↑令A陣列j迴圈數索引號陣列值是 累加i迴圈列j迴圈欄Arr陣列值轉化成的數值
      Next
      Z(T) = A
      '↑令T變數key以 新的A陣列放回Z字典中
   Next
q01: Next
'------------------------------
With Sheets("匯總").[A5].Resize(Z.Count, 14)
'↑以下是關於"匯總"工作表的[A5]擴展向下Z字典key數列,擴展向右14欄範圍儲存格,
'關於此範圍儲存格程序
   .Value = Application.Transpose(Application.Transpose(Z.Items))
   '↑令該範圍儲存格值以Z字典item轉置兩次的陣列值帶入
   .Sort KEY1:=.Item(1), Order1:=1, KEY2:=.Item(2), Order1:=1, Header:=2
   '↑令該範圍儲存格做2層次無標題列的正排序,第1層是第1欄,第2層是第2欄
   .Columns(7) = "=rank(F5," & .Columns(6).Address(1, 1) & ")"
   '↑令第7欄值是 第6欄的排名公式
   .Columns(14) = "=rank(M5," & .Columns(13).Address(1, 1) & ")"
   '↑令第14欄值是 第13欄的排名公式
End With
End Sub