VBA删除两列不同行重复值

liutian_126

为何方便清理账务，麻烦把借贷方相同的记录删除，当C列=D列时删除重复的两行记录

liulang0808

1. Sub del_same()
   
2.     Application.ScreenUpdating = False
   
3. l1:
   
4.     arr = [a1].CurrentRegion
   
5.     For j = 2 To UBound(arr)
   
6.         If Len(arr(j, 3)) > 0 Then
   
7.             For i = 2 To UBound(arr)
   
8.                 If arr(j, 3) = arr(i, 4) Then
   
9.                     Union(Cells(j, 1), Cells(i, 1)).EntireRow.Delete
   
10.                     GoTo l1
    
11.                 End If
    
12.             Next i
    
13. 
    
14.         End If
    
15.     Next j
    
16.     Application.ScreenUpdating = True
    
17. End Sub

复制代码

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, dic, i, j, m
  Set dic = CreateObject("scripting.dictionary")
  arr = [a1].CurrentRegion.Resize(, 6)
  For i = 2 To UBound(arr, 1)
    For j = 2 To UBound(arr, 1)
      If Len(arr(i, 3)) Then
       If arr(i, 3) = arr(j, 4) Then dic(i) = 1: dic(j) = 1: Exit For
      End If
    Next
  Next
  m = 1
  For i = 2 To UBound(arr, 1)
    If dic.exists(i) = False Then
      m = m + 1
      For j = 1 To UBound(arr, 2)
        arr(m, j) = arr(i, j)
      Next
    End If
  Next
  With [a1]
    .Resize(UBound(arr, 1) * 2, UBound(arr, 2)).ClearContents
    .Resize(m, UBound(arr, 2)) = arr
  End With
End Sub

liulang0808

附件内容供参考。。。。。。
C列或者D列有可能存在多个一样的值，这个有点麻烦的

FOB_FN_L

这个和那个分行的是不有点象，C   D列分行处理

liutian_126

liulang0808 发表于 2019-11-16 20:52

非常感谢，学习到了

cui26896

liulang0808 发表于 2019-11-16 20:53
附件内容供参考。。。。。。
C列或者D列有可能存在多个一样的值，这个有点麻烦的

版主想得是全面些，如果如果删除的值90.67,3676.00在C列中都出现了三次以上，在D列中只出了一次或两次，这种情况怎样处理呢？

liulang0808

cui26896 发表于 2019-11-16 22:52
版主想得是全面些，如果如果删除的值90.67,3676.00在C列中都出现了三次以上，在D列中只出了一次或两次， ...

测试上面的代码了吗，看看是否合适就知道了

cui26896

liulang0808 发表于 2019-11-16 23:08
测试上面的代码了吗，看看是否合适就知道了

看了，如果是在D列出现多个重复无法删除，如下图是在原图上改动后的表

作变动后的表

代码只是为了指表激活对象做了一点改动
Sub del_same()
    Application.ScreenUpdating = False
l1:
    With ThisWorkbook.Sheets(2)
    .Activate
    arr = .[a1].CurrentRegion
    For j = 2 To UBound(arr)
        If Len(arr(j, 3)) > 0 Then
            For i = 2 To UBound(arr)
                If arr(j, 3) = arr(i, 4) Then
                    Union(.Cells(j, 1), .Cells(i, 1)).EntireRow.Delete
                    GoTo l1
                End If
            Next i
        End If
    Next j
    End With
    Application.ScreenUpdating = True
End Sub
运行后的结果是下图：

如图，红色的的多余部分删除不掉！留个附件，请自行测试。
明细分类账.zip (16.22 KB, 下载次数: 12)

2019-11-17 12:14 上传

点击文件名下载附件

liulang0808

cui26896 发表于 2019-11-17 12:15
看了，如果是在D列出现多个重复无法删除，如下图是在原图上改动后的表

不知道您跟楼主是什么关系，数据的逻辑上是否欠考虑？
借方        贷方 这两个展示的数据跟楼主原来的意图有出入吧？

如果您单独有问题，请单独开贴，针对自己的问题举例详细描述
如果楼主的问题可以借鉴，建议理解楼主的意图，然后结合自己的需求理解下