- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-5-5
|
16#
發表於 2023-5-31 16:28
| 只看該作者
回復 11# 准提部林
謝謝論壇,謝謝前輩
後學藉此帖學習前輩的方案,方案學習心得註解如下,請前輩再指導
執行前:
執行結果:
Sub TEST_A01()
Dim Arr, xD, i&, T$, T1$, T2$, SR, S, xR As Range, xU As Range
'↑宣告變數
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD變數是 字典
With Range([J1], [A65536].End(3))
'↑以下是關於本表A~J欄儲存格的程序
.EntireRow.Interior.ColorIndex = xlNone
'↑令該區域全列底色是無色
.Offset(1, 7).ClearContents
'↑令該區域往下偏移1列,往右7欄區域儲存格清除內容
[H1:J1] = Array("重覆位置", "重覆次數", "對應場名稱")
'↑令[H1:J1]儲存格寫入列標題
Arr = .Cells
'↑令Arr變數是 二維陣列,以該區域儲存格值帶入陣列中
End With
For i = 2 To UBound(Arr)
'↑設順迴圈
T = Arr(i, 4): T2 = Arr(i, 6)
'↑令字串變數裝入陣列值
xD(T) = Trim(xD(T) & " " & i)
'↑令T變數當key,item是 自身連接空白字元,再連接i變數,所組成的新字串
If T2 <> "" Then xD(T & "/y") = T2
'↑如果T2變數不是空字元!就令T變數連接"/y"組成的新字串當key,
'item是T2變數,納入xD字典中
Next i
For i = 2 To UBound(Arr)
'↑設順迴圈
SR = Split(xD(Arr(i, 4) & ""), " ")
'↑令SR變數是一維陣列:以陣列第4欄值提取xD字典item,
'再以空白字元分割成為一維陣列
If UBound(SR) <= 0 Then GoTo i01
'↑如果SR陣列最後一個索引號<=0,就跳到標示i0位置繼續執行
T1 = "": T2 = "": Set xR = Range("D" & i)
'↑令T1,T2變數是 空字元,令xR變數是 D欄i列儲存格
For Each S In SR
'↑設逐項迴圈!令S變數是SR陣列值之一
If Val(S) <> i Then
'↑如果S變數轉數值後 與i變數不同
T1 = T1 & "," & "D" & S
'↑令T1變數是 自身連接逗號,再連接"D",最後連接S變數成新字串
T2 = T2 & "," & Arr(S, 1)
'↑令T2變數是 自身連接逗號,再連接S變數列第1欄Arr陣列值
End If
Next S
Arr(i, 6) = xD(Arr(i, 4) & "/y")
'↑令迴圈列第6欄Arr陣列值是 迴圈列第6欄Arr陣列值連接"/y"成的新字串,查
'查xD字典回傳的item值
Arr(i, 8) = Mid(T1, 2)
'↑令迴圈列第8欄Arr陣列值是 T1變數取第2字以後的全部字串
Arr(i, 9) = UBound(SR) + 1
'↑令迴圈列第9欄Arr陣列值是 SR陣列最大索引號+1
Arr(i, 10) = Mid(T2, 2)
'↑令迴圈列第10欄Arr陣列值是 T2變數取第2字以後的全部字串
If xU Is Nothing Then Set xU = xR Else Set xU = Union(xU, xR)
'↑如果xU變數是空的,就令xU變數是xR變數,否則就將xR變數納入xU儲存格集裡
i01: Next i
[a1].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
'↑令Arr陣列從[A1]開始寫入範圍儲存格中
If Not xU Is Nothing Then xU.EntireRow.Interior.ColorIndex = 6
'↑如果xU變數不是空的,就令該xU儲存格集所在的列整列底色為黃色
End Sub |
|
發表於 2021-3-6 11:28
| 
