提取不同列的相同内容

BU_PING

详细说明见附件中的说明工作表

shiruiqiang

三无产品，散了吧

limonet

shiruiqiang 发表于 2025-3-30 21:15
三无产品，散了吧

，大好人，科学环保低碳，我都想送花了。

BU_PING

非常抱歉，因为文件另存了，压缩文件时搞错文件了，重新上传

半百

BU_PING

半百 发表于 2025-3-31 09:28

试过了，代码通不过

ykcbf1100

附件供参考。。。

ykcbf1100

1. Sub ykcbf()    '//2025.3.31
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("原数据")
   
5.         arr = Intersect(.UsedRange, .[a:f])
   
6.     End With
   
7.     For i = 2 To UBound(arr)
   
8.         For j = 1 To UBound(arr, 2)
   
9.             If arr(i, j) <> Empty Then
   
10.                 s = arr(i, j)
    
11.                 d(s) = d(s) + 1
    
12.             End If
    
13.         Next
    
14.     Next
    
15.     ReDim brr(1 To d.Count, 1 To 1)
    
16.     For Each k In d.keys
    
17.         If d(k) > 1 Then
    
18.             m = m + 1
    
19.             brr(m, 1) = k
    
20.         End If
    
21.     Next
    
22.     With Sheets("结果")
    
23.         .UsedRange.Offset(1) = Empty
    
24.         Set Rng = .[a2].Resize(m, 1)
    
25.         Rng.Value = brr
    
26.     End With
    
27.     Set d = Nothing
    
28.     Application.ScreenUpdating = True
    
29. End Sub
    

复制代码

今铭昔

凌空一羽

function lkyy()
{
        let ar=Sheets("原数据").Range("a1").CurrentRegion().slice(1);
        let dic=new Map();
        let n=0;
        for(let a of ar){
                for(let b of a){
                        if(b != null){
                                if(dic.has(b)==false){
                                        dic.set(b,1);
                                }else{
                                        m=dic.get(b) ;
                                        dic.set(b,m + 1);
                                }
                        }
                }
        }
        let yr=["数据"]
        for(var a of dic.keys()){
                if(dic.get(a)>1){
                        yr.push(a)
                }
        }
        Range("a1").Resize(yr.length,1).Value2=WorksheetFunction.Transpose(yr)
}