標題: [分享] 重複次數指定內 全取 [打印本頁]

---

作者: hcm19522    時間: 2025-11-13 16:05     標題: 重複次數指定內 全取

[attach]38267[/attach][attach]38267[/attach]

---

作者: hcm19522    時間: 2025-11-13 16:06

(搜尋 輸入號碼 14536) google網址:https://hcm19522.blogspot.com/

---

作者: Andy2483    時間: 2025-11-18 08:10

回復 1# hcm19522


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

[attach]38279[/attach]


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

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)