返回列表 上一主題 發帖

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

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
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

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

2016猴年全勤獎章
2#
發表於 2019-3-26 10:28 | 只看該作者
  1. Sub zz()
  2. Dim d As Object, a, k, t, n&
  3. Set d = CreateObject("scripting.dictionary")
  4. a = [a1].CurrentRegion.Value
  5. For i = 1 To UBound(a)
  6.     k = a(i, 2)
  7.     If Not d.exists(k) Then
  8.         d(k) = Array("|" & i, a(i, 3))
  9.     Else
  10.         t = d(k)
  11.         t = Array(t(0) & "|" & i, t(1) + a(i, 3))
  12.         d(k) = t
  13.     End If
  14. Next
  15. t = d.items
  16. For i = 0 To UBound(t)
  17.     k = Split(t(i)(0), "|")
  18.     If UBound(k) < 6 Then
  19.         For ii = 1 To UBound(k)
  20.             n = n + 1
  21.             For j = 1 To UBound(a, 2)
  22.                 a(n, j) = a(k(ii), j)
  23.             Next
  24.         Next
  25.     End If
  26. Next
  27. [h2].Resize(n, j - 1) = a
  28. End Sub
複製代碼

TOP

hcm19522

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

熱烈參與勳章
3#
發表於 2019-3-26 10:35 | 只看該作者
https://blog.xuite.net/hcm19522/twblog/587182470
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 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: 3Rank: 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

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

2016猴年全勤獎章
6#
發表於 2019-3-27 09:06 | 只看該作者
回復 4# starry1314


    是分隔符。

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-27 
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

        靜思自在 : 有多少力量就做多少事，不要心存等待，等待才會落空。
返回列表 上一主題