求助

小星光

向大家老师求助

shiruiqiang

直接“数据”-“删除重复项目”快

小星光

shiruiqiang 发表于 2024-11-6 20:45
直接“数据”-“删除重复项目”快

可以用VBA删除吗

shiruiqiang

字典处理一下，基本代码，搜索一下

ykcbf1100

比较简单，字典来一个吧

ykcbf1100

参与一下。。。

Qs18

1. Sub qs()
   
2. Dim arr, i, dic
   
3. Set dic = CreateObject("scripting.dictionary")
   
4. With Sheet1
   
5.     arr = .Range("a2").CurrentRegion.Value
   
6.     ReDim brr(1 To UBound(arr), 1 To 2)
   
7.     For i = 1 To UBound(arr)
   
8.         s = arr(i, 1) & arr(i, 2)
   
9.         If Not dic.exists(s) Then
   
10.             m = m + 1
    
11.             dic(s) = m
    
12.             brr(m, 1) = arr(i, 1): brr(m, 2) = arr(i, 2)
    
13.         End If
    
14.     Next i
    
15.     .[k2].Resize(m, 2) = brr
    
16. End With
    
17. Set dic = Nothing
    
18. End Sub

复制代码

Qs18

试试......

Qs18

试试.........

翁知江安

Sub qctb()
Dim i, j, k
Dim t As Date
t = Time
Dim irow
Dim arr, brr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
irow = Sheet1.[a65536].End(xlUp).Row
arr = Sheet1.Range("a1:b" & irow)
For i = 2 To irow
d(arr(i, 1) & "," & arr(i, 2)) = ""
Next
ReDim brr(1 To d.Count, 1 To 2)
For Each k In d.keys
   j = j + 1
   brr(j, 1) = Split(k, ",")(0)
   brr(j, 2) = Split(k, ",")(1)
Next
Sheet1.[e1].Resize(UBound(brr), 2) = brr
MsgBox "ok"
MsgBox Time - t
End Sub