Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2265|回复: 4

[已解决]求VBA编程语句

[复制链接]
发表于 2012-11-23 19:30 | 显示全部楼层 |阅读模式
求VBA编程语句A列和B列有相同内容的单元格同时删除
最佳答案
2012-11-25 19:56
  1. Sub 去AB重复1()
  2.     Dim arr
  3.     On Error Resume Next
  4.     Dim dicA As Object, dicB As Object
  5.     Set dicA = CreateObject("scripting.dictionary")
  6.     Set dicB = CreateObject("scripting.dictionary")
  7.    
  8.     Dim arrA, arrB
  9.     Dim rowA&, rowB&, a
  10.     rowA = Range("a" & Rows.Count).End(xlUp).Row
  11.     rowB = Range("b" & Rows.Count).End(xlUp).Row
  12.     arrA = Range("a1:a" & rowA)
  13.     arrB = Range("b1:b" & rowB)
  14.    
  15.     For Each a In arrA
  16.         dicA(a) = a
  17.     Next
  18.    
  19.     For Each a In arrB
  20.         dicB(a) = a
  21.     Next
  22.    
  23.     If dicA.Count < dicB.Count Then
  24.         For Each a In dicA.keys
  25.             If dicB.exists(a) Then
  26.                 dicB.Remove (a)
  27.                 dicA.Remove (a)
  28.             End If
  29.         Next
  30.     Else
  31.         For Each a In dicB.keys
  32.             If dicA.exists(a) Then
  33.                 dicB.Remove (a)
  34.                 dicA.Remove (a)
  35.             End If
  36.         Next
  37.     End If
  38.    
  39.     Range("a:b").Clear
  40.     Range("a1").Resize(dicA.Count) = WorksheetFunction.Transpose(dicA.keys)
  41.     Range("b1").Resize(dicB.Count) = WorksheetFunction.Transpose(dicB.keys)
  42. End Sub


  43. Sub 去AB重复2()
  44.     Dim arr, a, i&
  45.     On Error Resume Next
  46.     Dim dicA As Object, dicB As Object
  47.     Set dicA = CreateObject("scripting.dictionary")
  48.     Set dicB = CreateObject("scripting.dictionary")
  49.    
  50.     arr = Range("a1").CurrentRegion
  51.     For i = 1 To UBound(arr)
  52.         dicA(arr(i, 1)) = ""
  53.         dicB(arr(i, 2)) = ""
  54.     Next
  55.    
  56.     If dicA.Count < dicB.Count Then
  57.         For Each a In dicA.keys
  58.             If dicB.exists(a) Then
  59.                 dicB.Remove (a)
  60.                 dicA.Remove (a)
  61.             End If
  62.         Next
  63.     Else
  64.         For Each a In dicB.keys
  65.             If dicA.exists(a) Then
  66.                 dicB.Remove (a)
  67.                 dicA.Remove (a)
  68.             End If
  69.         Next
  70.     End If
  71.    
  72.     Range("a:b").Clear
  73.     Range("a1").Resize(dicA.Count) = WorksheetFunction.Transpose(dicA.keys)
  74.     Range("b1").Resize(dicB.Count) = WorksheetFunction.Transpose(dicB.keys)
  75. End Sub
复制代码
发表于 2012-11-23 20:00 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2012-11-25 19:21 | 显示全部楼层
hwc2ycy 发表于 2012-11-23 20:00
是要求在两列同行删除还是?

只删除A列中与B列中任一行相同的单元格
回复

使用道具 举报

发表于 2012-11-25 19:56 | 显示全部楼层    本楼为最佳答案   
  1. Sub 去AB重复1()
  2.     Dim arr
  3.     On Error Resume Next
  4.     Dim dicA As Object, dicB As Object
  5.     Set dicA = CreateObject("scripting.dictionary")
  6.     Set dicB = CreateObject("scripting.dictionary")
  7.    
  8.     Dim arrA, arrB
  9.     Dim rowA&, rowB&, a
  10.     rowA = Range("a" & Rows.Count).End(xlUp).Row
  11.     rowB = Range("b" & Rows.Count).End(xlUp).Row
  12.     arrA = Range("a1:a" & rowA)
  13.     arrB = Range("b1:b" & rowB)
  14.    
  15.     For Each a In arrA
  16.         dicA(a) = a
  17.     Next
  18.    
  19.     For Each a In arrB
  20.         dicB(a) = a
  21.     Next
  22.    
  23.     If dicA.Count < dicB.Count Then
  24.         For Each a In dicA.keys
  25.             If dicB.exists(a) Then
  26.                 dicB.Remove (a)
  27.                 dicA.Remove (a)
  28.             End If
  29.         Next
  30.     Else
  31.         For Each a In dicB.keys
  32.             If dicA.exists(a) Then
  33.                 dicB.Remove (a)
  34.                 dicA.Remove (a)
  35.             End If
  36.         Next
  37.     End If
  38.    
  39.     Range("a:b").Clear
  40.     Range("a1").Resize(dicA.Count) = WorksheetFunction.Transpose(dicA.keys)
  41.     Range("b1").Resize(dicB.Count) = WorksheetFunction.Transpose(dicB.keys)
  42. End Sub


  43. Sub 去AB重复2()
  44.     Dim arr, a, i&
  45.     On Error Resume Next
  46.     Dim dicA As Object, dicB As Object
  47.     Set dicA = CreateObject("scripting.dictionary")
  48.     Set dicB = CreateObject("scripting.dictionary")
  49.    
  50.     arr = Range("a1").CurrentRegion
  51.     For i = 1 To UBound(arr)
  52.         dicA(arr(i, 1)) = ""
  53.         dicB(arr(i, 2)) = ""
  54.     Next
  55.    
  56.     If dicA.Count < dicB.Count Then
  57.         For Each a In dicA.keys
  58.             If dicB.exists(a) Then
  59.                 dicB.Remove (a)
  60.                 dicA.Remove (a)
  61.             End If
  62.         Next
  63.     Else
  64.         For Each a In dicB.keys
  65.             If dicA.exists(a) Then
  66.                 dicB.Remove (a)
  67.                 dicA.Remove (a)
  68.             End If
  69.         Next
  70.     End If
  71.    
  72.     Range("a:b").Clear
  73.     Range("a1").Resize(dicA.Count) = WorksheetFunction.Transpose(dicA.keys)
  74.     Range("b1").Resize(dicB.Count) = WorksheetFunction.Transpose(dicB.keys)
  75. End Sub
复制代码
回复

使用道具 举报

发表于 2012-11-25 19:56 | 显示全部楼层
两种方法,任选一种。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 16:47 , Processed in 0.690885 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表