在一个工作簿所有工作表中找重复

BU_PING

在一个工作簿的所有工作表中找重复，把结果放在"查询结果"工作表中，详情见附件第一个工作表中的说明。请用VBA完成。

BU_PING

请用用VBA完成

shiruiqiang

便利工作表，数组循环，like就+1

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.1.12
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set sh = ThisWorkbook.Sheets("查询结果")
   
4.     For Each sht In Sheets
   
5.         If sht.Name <> sh.Name Then
   
6.             If sht.UsedRange.Count > 10 Then
   
7.                 arr = sht.UsedRange
   
8.                 For i = 2 To UBound(arr)
   
9.                     s = arr(i, 2)
   
10.                     If Not d.exists(s) Then
    
11.                         d(s) = Array(s, arr(i, 3))
    
12.                     End If
    
13.                 Next
    
14.             End If
    
15.         End If
    
16.     Next
    
17.     With sh
    
18.         .[b2:c10000] = ""
    
19.         .Columns(2).NumberFormatLocal = "@"
    
20.         .[b2].Resize(d.Count, 2) = Application.Rept(d.Items, 1)
    
21.     End With
    
22.     Set d = Nothing
    
23.     MsgBox "OK！"
    
24. End Sub

复制代码

gwjkkkkk

利用字典累加...

BU_PING

ykcbf1100 发表于 2024-1-12 20:26
参与一下。。。

我试试看，感恩您。有问题再请教，按钮名称应该是“找重”，而不是去重，对吗？

ykcbf1100

BU_PING 发表于 2024-1-12 21:49
我试试看，感恩您。有问题再请教，按钮名称应该是“找重”，而不是去重，对吗？

那应该是做反了，有时间我重做一下吧。

BU_PING

ykcbf1100 发表于 2024-1-12 21:54
那应该是做反了，有时间我重做一下吧。

好的，感恩您！找到的内容至少出现在两个工作表中；

ykcbf1100

BU_PING 发表于 2024-1-12 21:58
好的，感恩您！找到的内容至少出现在两个工作表中；

已更改。。。