返回列表 上一主題 發帖

[發問] (已解決)如何列出相同部門的員工

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
1# 跳轉到 »
發表於 2023-3-30 12:51 | 顯示全部帖子
本帖最後由 Andy2483 於 2023-3-30 12:59 編輯

回復 6# Hsieh


    謝謝論壇,謝謝前輩
後學藉此帖練習陣列與字典,學習的方案如下,請各位前輩指教

執行前:


執行結果:



Option Explicit
Sub TEST()
Dim Brr, Crr, i&, xR, Y
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([B2], Cells(Rows.Count, 1).End(3)): Brr = xR
For i = 1 To UBound(Brr)
   If Y(Brr(i, 1)) = "" Then Y(Brr(i, 1)) = Y.Count
Next
With [K1].Resize(, Y.Count)
   .EntireColumn.ClearContents
   .Value = Y.keys
End With
ReDim Crr(UBound(Brr), 1 To Y.Count)
For i = 1 To UBound(Brr)
   Crr(Y(Brr(i, 1) & "|"), Y(Brr(i, 1))) = Brr(i, 2)
   Y(Brr(i, 1) & "|") = Y(Brr(i, 1) & "|") + 1
Next
[K2].Resize(UBound(Crr), UBound(Crr, 2)) = Crr
Set Y = Nothing: Set xR = Nothing: Erase Brr, Crr
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
2#
發表於 2023-3-30 13:51 | 顯示全部帖子
謝謝論壇,謝謝各位前輩
後學藉此帖練習字典中的陣列編輯,請各位前輩指教

Option Explicit
Sub TEST_2()
Dim Brr, Crr, i&, R&, xR, Y, Z, V, N
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([B2], Cells(Rows.Count, 1).End(3)): Brr = xR
R = UBound(Brr): ReDim A(1 To R, 0)
For i = 1 To R
   If Not IsArray(Brr(i, 1)) Then Y(Brr(i, 1)) = A
Next
With [K1].Resize(, Y.Count)
   .EntireColumn.ClearContents: .Value = Y.keys
End With
For i = 1 To R
   Z = Y(Brr(i, 1)): Y(Brr(i, 1) & "|") = Y(Brr(i, 1) & "|") + 1
   Z(Y(Brr(i, 1) & "|"), 0) = Brr(i, 2): Y(Brr(i, 1)) = Z
Next
For Each V In Y.Items
   If IsArray(V) Then N = N + 1: [K2].Item(1, N).Resize(R, 1) = V
Next
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 欣賞別人就是莊嚴自己。
返回列表 上一主題