Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 100), V&, Z, A, i&, N%, xA As Range
'↑宣告變數,Crr變數是一維陣列,索引號1~100
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是 字典
Set xA = [B7:K8]
'↑令xA變數是物件儲存格 [B7:K8]
For i = 0 To 2
'↑設順迴圈!令i從0 到2
Brr = xA.Offset(i * 3)
'↑令Brr變數是 帶入迴圈區域儲存格值的二維陣列
For Each A In Brr
'↑設逐項迴圈!令A變數是Brr陣列裡的陣列值
If Trim(A) = "" Then GoTo A01 Else V = Val(A)
'↑如果A變數去除頭尾空白字元後是 空字元!就跳到標示A01位置繼續執行,
'否則就令V變數是 A變數轉成的數值
If Z(V) = i Then Z(V) = i + 1
'↑如果以V變數查Z字典回傳item值是同 i變數,就令其item值+1
If Z(V) = 3 Then N = N + 1: Crr(N) = V: Z(V) = 0
'↑如果以V變數查Z字典回傳item值是3 ,就令N變數累加1,
'令第N變數個Crr陣列值是 變數,令Z字典裡V變數key對應的item值是0
A01: Next
Next
With [B18].Resize(, N)
'↑以下是關於[B18]儲存格擴展向右N變數個儲存格區域的程序
.Value = Crr
'↑令該區域儲存格值以Crr陣列值帶入
.Sort KEY1:=.Item(1), Order1:=1, Header:=2, Orientation:=2
'↑令該區域做無標題的橫向順排序
End With
End Sub
發表於 2023-12-14 09:32
| 
