数据去重合并问题求助

6720918hw

原始的数据是两两一组的，很多组

根据重复项合并去重后，最终得到无重复项的大组

这个怎么好实现呢  求大神指导  

Qs18

去重好理解，就是您的大组1,2，3，4个数是什么规律得到呢？

ykcbf1100

同问，大组1,2，3，4个数是怎么得来的？

6720918hw

Qs18 发表于 2024-5-21 10:37
去重好理解，就是您的大组1,2，3，4个数是什么规律得到呢？

两两一组，有重复的合并去重，例如第一组AB和第二组AD有相同的A，合并去重后得到ABD；
ABD再和第三组CD有相同的D去重合并得到ABCD,ABCD再和BN有相同的B去重合并得到ABCDN，最后跟其他小组的两个元素都没重复后得到ABCDN（第一大组）。
LM与其他小组无重复项，最终还是LM一组

6720918hw

ykcbf1100 发表于 2024-5-21 10:45
同问，大组1,2，3，4个数是怎么得来的？

大佬，是这样的，原始数据是两两一组，现在是要把有重复的合并去重，例如第一组AB和第二组AD有相同的A，合并去重后得到ABD；
ABD再和第三组CD有相同的D去重合并得到ABCD,ABCD再和BN有相同的B去重合并得到ABCDN，最后跟其他小组的两个元素都没重复后得到ABCDN（第一大组）。

LM与其他小组无重复项，最终还是LM一组

taller

1. Sub Demo()
   
2.     Dim i, j, c, it, Arr, sList, iCnt, sNew, oC As New Collection
   
3.     Arr = Range("B3:C12")
   
4.     oC.Add Arr(1, 1) & " " & Arr(1, 2)
   
5.     For i = LBound(Arr) + 1 To UBound(Arr)
   
6.         iCnt = oC.Count
   
7.         For j = iCnt To 1 Step -1
   
8.             sList = oC(j): sNew = ""
   
9.             If InStr(sList, Arr(i, 1)) Then
   
10.                 sNew = sList & " " & Arr(i, 2)
    
11.                 Exit For
    
12.             ElseIf InStr(sList, Arr(i, 2)) Then
    
13.                 sNew = sList & " " & Arr(i, 1)
    
14.                 Exit For
    
15.             End If
    
16.         Next
    
17.         If sNew = "" Then
    
18.             oC.Add Arr(i, 1) & " " & Arr(i, 2)
    
19.         Else
    
20.             oC.Add sNew
    
21.             oC.Remove j
    
22.         End If
    
23.     Next
    
24.     Set c = Range("K10")
    
25.     For Each it In oC
    
26.         Arr = Split(it)
    
27.         c.Resize(1, UBound(Arr) + 1).Value = Arr
    
28.         Set c = c.Offset(1)
    
29.     Next
    
30. End Sub

复制代码

taller

6720918hw

taller 发表于 2024-5-21 11:00

多谢大佬指导  我来试试

6720918hw

taller 发表于 2024-5-21 10:58

大佬  试了下结果好像有点问题，应该最后是4大组  有一组没合并完

Qs18

6720918hw 发表于 2024-5-21 12:00
大佬  试了下结果好像有点问题，应该最后是4大组  有一组没合并完

和您的逻辑不在一个频段上，没有理解真正的意思。即使写出来了，也有可能不是您心里希望得到的结果