删重

ddz79101

老师，有数据需删重，但非单元格删重，而是每三行为一个区块，比较每个区块的中代码或名称的一致性（簿考虑金额。有重复则删除区块。请老师指导。谢谢！

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.4.4
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = Cells(Rows.Count, 1).End(3).Row
   
4.     arr = [a1].Resize(r, 9)
   
5.     ReDim brr(1 To UBound(arr), 1 To 9)
   
6.     For i = 2 To UBound(arr) Step 3
   
7.         s = arr(i, 5) & "|" & arr(i + 1, 5) & "|" & arr(i + 2, 5)
   
8.         If Not d.exists(s) Then
   
9.             d(s) = i
   
10.         End If
    
11.     Next
    
12.     For Each k In d.keys
    
13.         t = d(k)
    
14.         For x = 1 To 3
    
15.             m = m + 1
    
16.             For j = 1 To UBound(arr, 2)
    
17.                 brr(m, j) = arr(t + x - 1, j)
    
18.             Next
    
19.         Next
    
20.     Next
    
21.     [l2].Resize(1000, 9) = ""
    
22.     [l2].Resize(m, 9) = brr
    
23.     MsgBox "OK！"
    
24. End Sub
    

复制代码

limonet

关键字：字典

limonet

Sub limonet()
    Dim i%, Arr As Variant, Dic As Object
    Set Dic = CreateObject("scripting.dictionary")
    For i = 2 To Range("E" & Rows.Count).End(xlUp).Row Step 3
        Arr = Application.Transpose(Range(Cells(i, "E"), Cells(i + 2, "E")))
        If Not Dic.exists(Join(Arr)) Then
            Dic(Join(Arr)) = ""
            Cells(Range("L" & Rows.Count).End(xlUp).Row + 1, "L").Resize(3, 9) = Range(Cells(i, "A"), Cells(i + 2, "I")).Value
        End If
    Next i
End Sub

蓝桥玄霜

删重的例子：

shiruiqiang

ddz79101

ykcbf1100 发表于 2024-4-4 20:49
附件供参考。。。

谢谢老师！

ddz79101

limonet 发表于 2024-4-4 20:56
关键字：字典

谢谢老师！运行代码成功

ddz79101

蓝桥玄霜 发表于 2024-4-4 20:58
删重的例子：

谢谢老师！