[已解决]数据检查的VBA代码

安全网

求助对A/B/C列数据进行重复性检查，如果在A列存在的就删除B/C列重复数据，如果A列不存在的就添加在A列末位VBA

最佳答案

月排行榜 / 总排行榜

grf1973

2015-12-11 15:41

这样简单。

1. Sub grf()
   
2.     arr = [a2].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For j = 2 To 4
   
5.         For i = 2 To UBound(arr)
   
6.             If Len(arr(i, j)) And arr(i, j) <> "汇总" Then d(arr(i, j)) = ""
   
7.         Next
   
8.     Next
   
9.     [g3].Resize(d.Count, 1) = Application.Transpose(d.keys)
   
10. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub grf()
   
2.     arr = [a2].CurrentRegion
   
3.     ReDim brr(1 To 3 * UBound(arr), 1 To 3)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     For i = 2 To UBound(arr)
   
6.         If Len(arr(i, 2)) And arr(i, 2) <> "汇总" Then
   
7.             d(arr(i, 2)) = ""
   
8.             n = n + 1
   
9.             brr(n, 1) = arr(i, 2)
   
10.         End If
    
11.     Next
    
12.     For j = 3 To 4
    
13.         For i = 2 To UBound(arr)
    
14.             brr(i, j - 1) = arr(i, j)
    
15.             If Len(arr(i, j)) And arr(i, j) <> "汇总" Then
    
16.                 If Not d.exists(arr(i, j)) Then
    
17.                     d(arr(i, j)) = ""
    
18.                     n = n + 1
    
19.                     brr(n, 1) = arr(i, j)
    
20.                 Else
    
21.                     brr(i, j - 1) = ""
    
22.                 End If
    
23.             End If
    
24.         Next
    
25.     Next
    
26.     [g3].Resize(n, 3) = brr
    
27. End Sub
    

复制代码

安全网

grf1973 发表于 2015-12-11 14:31

不重复的数据复制完后原删除掉原数据

grf1973

这样简单。

1. Sub grf()
   
2.     arr = [a2].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For j = 2 To 4
   
5.         For i = 2 To UBound(arr)
   
6.             If Len(arr(i, j)) And arr(i, j) <> "汇总" Then d(arr(i, j)) = ""
   
7.         Next
   
8.     Next
   
9.     [g3].Resize(d.Count, 1) = Application.Transpose(d.keys)
   
10. End Sub
    

复制代码

安全网

grf1973 发表于 2015-12-11 14:31

这个名称检查如果是从第2列到第9列怎么修改参数

sry660

安全网 发表于 2015-12-12 08:45
这个名称检查如果是从第2列到第9列怎么修改参数

1. Sub grf()       '在grf老师的代码上略作调整即可
   
2.     arr = [a2].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For j = 2 To ubound(arr,2)    '取arr第二维的最大下标（即横向的最大列数），或直接将ubound(arr,2)改为9即可
   
5.         For i = 2 To UBound(arr)
   
6.             If Len(arr(i, j)) And arr(i, j) <> "汇总" Then d(arr(i, j)) = ""
   
7.         Next
   
8.     Next
   
9.     [g3].Resize(d.Count, 1) = Application.Transpose(d.keys)
   
10. End Sub

复制代码