[已解决]删除表格中数字相同的行

ymq123

请编写代码
      1、在工作表1中，表格1、2、3、4有两行以上相同数字的行，只要数字相同的行大于二行，把这些相同的行都删除.
      2、如表1中第一、二、三行是相同的，把这三行都删除。
      3、筛选后的内容放到工作表2里，表1筛选后的内容放到表5里，表2筛选后的内容放到表6里，表3筛选后的内容放到表7里，表4筛选后的内容放到表8里，
谢谢！

最佳答案

月排行榜 / 总排行榜

grf1973

2014-4-28 13:44

好多以前做过。。。。。

1. Private Sub CommandButton1_Click()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Sheets("2").UsedRange.ClearContents
   
4.     For y = 1 To 4
   
5.         r = IIf(y <= 2, 1, 255)
   
6.         c = IIf(y Mod 2 = 1, 1, 15)
   
7.         arr = Sheet1.Cells(r, c).Resize(253, 9)
   
8.         ReDim zff(1 To UBound(arr, 2))
   
9.         ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
10.         For i = 1 To UBound(arr)
    
11.             N = 0
    
12.             For k = 1 To UBound(arr, 2)
    
13.                 zff(k) = arr(i, k)
    
14.             Next
    
15.             zf = Join(zff, ",")
    
16.             d(zf) = d(zf) + 1
    
17.         Next
    
18.         dk = d.keys: dt = d.items
    
19.         For i = 0 To UBound(dk)
    
20.             If dt(i) = 1 Then
    
21.                 s = s + 1
    
22.                 For x = 1 To UBound(arr, 2)
    
23.                     brr(s, x) = Split(dk(i), ",")(x - 1)
    
24.                 Next
    
25.             End If
    
26.         Next
    
27.         r1 = IIf(y <= 2, 1, 128)
    
28.         Sheets("2").Cells(r1, c).Resize(s, 9) = brr
    
29.         s = 0
    
30.         d.RemoveAll
    
31.     Next
    
32. End Sub
    

复制代码

跳转到最佳答案楼层

冥王

不要重复发帖  
如果你的问题太复杂要求太多    建议将复杂的问题拆成一个个的小问题  这样更有利于在论坛获得解决的办法

ymq123

冥王 发表于 2014-4-28 11:28
不要重复发帖  
如果你的问题太复杂要求太多    建议将复杂的问题拆成一个个的小问题  这样更有利于在论坛 ...

不是重复的，内容不同
修正错误：“只要数字相同的行大于二行”这句话中 “大于二行”改为”大于一行“

grf1973

好多以前做过。。。。。

1. Private Sub CommandButton1_Click()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Sheets("2").UsedRange.ClearContents
   
4.     For y = 1 To 4
   
5.         r = IIf(y <= 2, 1, 255)
   
6.         c = IIf(y Mod 2 = 1, 1, 15)
   
7.         arr = Sheet1.Cells(r, c).Resize(253, 9)
   
8.         ReDim zff(1 To UBound(arr, 2))
   
9.         ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
10.         For i = 1 To UBound(arr)
    
11.             N = 0
    
12.             For k = 1 To UBound(arr, 2)
    
13.                 zff(k) = arr(i, k)
    
14.             Next
    
15.             zf = Join(zff, ",")
    
16.             d(zf) = d(zf) + 1
    
17.         Next
    
18.         dk = d.keys: dt = d.items
    
19.         For i = 0 To UBound(dk)
    
20.             If dt(i) = 1 Then
    
21.                 s = s + 1
    
22.                 For x = 1 To UBound(arr, 2)
    
23.                     brr(s, x) = Split(dk(i), ",")(x - 1)
    
24.                 Next
    
25.             End If
    
26.         Next
    
27.         r1 = IIf(y <= 2, 1, 128)
    
28.         Sheets("2").Cells(r1, c).Resize(s, 9) = brr
    
29.         s = 0
    
30.         d.RemoveAll
    
31.     Next
    
32. End Sub
    

复制代码

grf1973

请看附件。

grf1973

以前做过的是把重复的筛选出来，现在做的是把不重复的筛选出来，如此而已。