请大神们帮帮忙！找一下犯罪团伙！！！

笨鸟飞不高

usedrange

参与学习

1. Sub t()
   
2.     Dim arr, brr, m%, dic, sh, k, t, i%, j%, r%, n%, m1$
   
3.     Set dic = CreateObject("scripting.dictionary")
   
4.     With Sheets("原表")
   
5.         m = .[a2].End(4).Row
   
6.         Set sh = .Range("a2").CurrentRegion
   
7.         sh.Sort key1:="案件编号", order1:=1, Header:=xlYes
   
8.         arr = .Range("a2:p" & m)
   
9.         For i = 1 To UBound(arr)
   
10.             dic(arr(i, 15)) = dic(arr(i, 15)) & "|" & arr(i, 1)
    
11.         Next i
    
12.         ReDim brr(1 To 60, 1 To 2): r = 1: n = 1: m1 = ""
    
13.         For Each k In dic.keys
    
14.             t = UBound(Split(dic(k), "|"))
    
15.             If t > 2 And dic(k) <> m1 Then
    
16.                 m1 = dic(k)
    
17.                 For j = 1 To m - 1
    
18.                     If InStr(dic(k), arr(j, 1)) Then
    
19.                         brr(r, 1) = n
    
20.                         brr(r, 2) = arr(j, 15)
    
21.                         r = r + 1
    
22.                     End If
    
23.                 Next j
    
24.                 n = n + 1
    
25.             End If
    
26.             
    
27.         Next k
    
28.         Sheets("团伙").[w2].Resize(UBound(brr), 2) = brr
    
29.     End With
    
30.     Set dic = Nothing
    
31.     Set sh = Nothing
    
32. End Sub

复制代码

grf1973

lczzzzzzz 发表于 2024-6-30 18:11
大神，代码放在实际数据中还是不够精准啊！找出的团伙是满足了三人且三案，但不满足其中两人要在三起案件 ...

要是这样的话反而简单吧。

魂断蓝桥

少年郎0

用jsa试了下