　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2019-3-26 09:17 | 只看該作者

[發問] 如何列出指定重複次數以內的資料呢?

[版主管理留言]

GBKEE(2019/3/28 08:03): 附檔中沒看到SQL語法

1.需要列出項目名稱重複出現次數是在指定的數字內的資料

目前是用SQL語法列出群組計算有哪些品項符合,在由這些資料去進行查詢
但語法串的密密麻麻....變得很難維護

列出_指定重複次數以內的資料.rar (8.53 KB)

樓主熱帖

ikboy

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 16
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2024-3-28

2016猴年全勤獎章

2^#

發表於 2019-3-26 10:28 | 只看該作者

Sub zz()
Dim d As Object, a, k, t, n&
Set d = CreateObject("scripting.dictionary")
a = [a1].CurrentRegion.Value
For i = 1 To UBound(a)
k = a(i, 2)
If Not d.exists(k) Then
d(k) = Array("|" & i, a(i, 3))
Else
t = d(k)
t = Array(t(0) & "|" & i, t(1) + a(i, 3))
d(k) = t
End If
Next
t = d.items
For i = 0 To UBound(t)
k = Split(t(i)(0), "|")
If UBound(k) < 6 Then
For ii = 1 To UBound(k)
n = n + 1
For j = 1 To UBound(a, 2)
a(n, j) = a(k(ii), j)
Next
Next
End If
Next
[h2].Resize(n, j - 1) = a
End Sub

複製代碼

TOP

hcm19522

大學生 Rank: 4

帖子: 1360
主題: 4
精華: 0
積分: 1370
點名: 0
作業系統: WIN
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2015-9-11
最後登錄: 2024-4-19

熱烈參與勳章

3^#

發表於 2019-3-26 10:35 | 只看該作者

https://blog.xuite.net/hcm19522/twblog/587182470

google"EXCEL迷" blog 或google網址:https://hcm19522.blogspot.com/

TOP

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

4^#

發表於 2019-3-26 15:51 | 只看該作者

回復 2# ikboy

感謝~符合需求
想請問 "|" 這個的用意是?

TOP

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

5^#

發表於 2019-3-26 15:53 | 只看該作者

回復 3# hcm19522
感謝~雖然有達到目標
但因為數量有數萬列,使用函數會運算很久

還是感謝幫忙了!

TOP

ikboy

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 16
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2024-3-28

2016猴年全勤獎章

6^#

發表於 2019-3-27 09:06 | 只看該作者

回復 4# starry1314

是分隔符。

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2798
主題: 10
精華: 0
積分: 2854
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-4-15

7^#

發表於 2019-3-28 10:15 | 只看該作者

Sub TEST()
Dim Arr, xD, N&, i&, j%
Arr = Range([A1], [B65536].End(xlUp)(1, 2))
Set xD = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Arr)
xD(Arr(i, 2) & "") = xD(Arr(i, 2) & "") + 1
Next
For i = 2 To UBound(Arr)
If xD(Arr(i, 2) & "") > 5 Then GoTo 101
N = N + 1
For j = 1 To 3: Arr(N + 1, j) = Arr(i, j): Next
101: Next
If N > 0 Then [H2].Resize(N + 1, 3) = Arr
End Sub

TOP