VBA只保留出现过一次的

困顿的人

grf1973 发表于 2022-12-29 15:16
换个思路。。。。

1. Sub 删除多次出现的()
   
2. Dim s, brr, i1%
   
3. Dim k1
   
4. Dim arr, crr, d, m%, n%
   
5.     arr = Sheets("重复数据").Range("a3:o" & Cells(Rows.Count, "d").End(xlUp).Row)
   
6.     n = Sheets("重复数据").Cells(Rows.Count, "d").End(xlUp).Row
   
7.    
   
8.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
9.     Set d = CreateObject("scripting.dictionary")
   
10.     For i = 1 To UBound(arr)
    
11.         s = arr(i, 2) & "|" & arr(i, 4)
    
12.         d(s) = d(s) + 1
    
13.     Next
    
14.     For i = 1 To UBound(arr)
    
15.         s = arr(i, 2) & "|" & arr(i, 4)
    
16.         If d(s) = 1 Then
    
17.             m = m + 1
    
18.             For j = 1 To UBound(arr, 2)
    
19.                 brr(m, j) = arr(i, j)
    
20.             Next
    
21.         End If
    
22.         If d(s) > 1 Then
    
23.             s = arr(i, 2) & "|" & arr(i, 4)
    
24.             For Each sh In Sheets
    
25.               If sh.Name = arr(i, 8) Then
    
26.                 k1 = sh.Range("d65536").End(xlUp).Row
    
27.                 crr = sh.Range("a3:o" & k1)
    
28.                 For i1 = 1 To UBound(brr)
    
29.                    If crr(i1, 2) & "|" & crr(i1, 4) = s Then
    
30.                    sh.Range("a" & i1).EntireRow.Delete: shift = xlUp
    
31.                    End If
    
32.                 Next
    
33.               End If
    
34.             Next
    
35.         End If
    
36.     Next
    
37.      Sheets("重复数据").[a3].Resize(n, 15).ClearContents
    
38.      Sheets("重复数据").[a3].Resize(m, UBound(brr, 2)) = brr
    
39.      Sheets("重复数据").[a3].Resize(m, UBound(brr, 2)).Borders.LineStyle = 1
    
40. End Sub
    
41. 老师 删除“重复数据”表格中的        身份证号码和姓名 同时出现多次的数据 比如这两个数据 <img src="https://club.excelhome.net/forum.php?mod=image&aid=2846649&size=300x300&key=afa58ef65a957a08&nocache=yes&type=fixnone" border="0" aid="attachimg_2846649" alt="">出现了两次 则把他们全部删除 并且在其他三个表格中 找到这些数据 并且也删除掉相应的整行数据，个人感觉代码思路没有错误，就是在运行的时候出现小标越界，麻烦老师再次帮忙 谢谢

复制代码

困顿的人

grf1973 发表于 2022-12-29 15:16
换个思路。。。。

第一个表格中 删除重复大于一次的数据（身份证号和姓名都相同的数据才属于重复数据），并且在其他表格中 也删除相应数据的整行

蓝桥玄霜

困顿的人 发表于 2022-12-29 10:59
老师代码运行出现错误

请仔细核对抄写的代码，初学者常常会抄错的。
或者上传出错的代码和附件看看。

困顿的人

grf1973 发表于 2022-12-29 15:16
换个思路。。。。

老师 满足身份证号和姓名 都不一样

困顿的人

ykcbf1100 发表于 2022-12-29 10:40
这样就可以。

老师 代码运行出现错误

ykcbf1100

困顿的人 发表于 2022-12-30 15:29
老师 代码运行出现错误

我这里都好好的，到你那里就出现错误了？
你用13楼的代码吧。