返回列表 上一主題 發帖

[分享] 重複次數指定內 全取

hcm19522

帖子
1796 
主題
184 
精華
0 
積分
1985 
點名
0  
作業系統
WIN 
軟體版本
2007 
閱讀權限
100 
性別
男 
註冊時間
2015-9-11 
最後登錄
2026-9-24 

熱烈參與勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2025-11-13 16:05 | 只看該作者

[分享] 重複次數指定內 全取

收藏 分享
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

hcm19522

帖子
1796 
主題
184 
精華
0 
積分
1985 
點名
0  
作業系統
WIN 
軟體版本
2007 
閱讀權限
100 
性別
男 
註冊時間
2015-9-11 
最後登錄
2026-9-24 

熱烈參與勳章
2#
發表於 2025-11-13 16:06 | 只看該作者
(搜尋 輸入號碼 14536) google網址:https://hcm19522.blogspot.com/
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
3#
發表於 2025-11-18 08:10 | 只看該作者
回復 1# hcm19522


    謝謝前輩分享此主題,後學藉此帖練習陣列與字典,請各位前輩指教




Option Explicit
Sub TEST()
Dim Brr, V&, Z, i&, R&, N&
Set Z = CreateObject("Scripting.Dictionary")
Brr = [B1].CurrentRegion
[G2].Resize(ActiveSheet.UsedRange.Rows.Count, 2).ClearContents
V = Val([E2])
For i = 2 To UBound(Brr)
   N = Z(Brr(i, 2)) + 1: Z(Brr(i, 2)) = N
   If N <= V Then
      R = R + 1
      Brr(R, 1) = Brr(i, 1)
      Brr(R, 2) = Brr(i, 2)
   End If
Next
If R > 0 Then [G2].Resize(R, 2) = Brr
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 吃苦了苦、苦盡廿來，享福了福、福盡悲來。
返回列表 上一主題