[已解决]删除表格里所相同的行

ymq123 · 发表于 2014-12-22 15:36

请编写代码
1、工作表2有4个表格（或者有更多表格），删除里面大于等于2个相同的行，保留不相同的行。相同的行已用背景色标注，删除结果放到工作表3中，
2、删除结果如工作表4

最佳答案

爱疯

2014-12-22 18:28

Private Sub CommandButton1_Click()
Dim A, B, C, d, i%, j%, k%, s1, t, s2
A = Sheets(2).UsedRange
ReDim B(1 To UBound(A), 1 To UBound(A, 2))
Set d = CreateObject("scripting.dictionary")
For k = 1 To UBound(A, 2) Step 11
      '字典录入
      d.RemoveAll
      For i = 1 To UBound(A)
         t = ""
         For j = k To k + 9
            t = t & "," & A(i, j)
         Next j
         d(t) = d(t) + 1
      Next i
      '给输出数组B赋值
      s1 = 0
      For Each t In d.keys
         If d(t) = 1 Then
            s1 = s1 + 1: s2 = 0
            C = Split(t, ",")
            For j = k To k + 9
                  s2 = s2 + 1
                  B(s1, j) = C(s2)
            Next j
         End If
      Next
Next k
Sheets(3).UsedRange = ""
Sheets(3).Range("a1").Resize(UBound(B), UBound(B, 2)) = B
End Sub

删除表格里所相同的行2.rar (28.81 KB, 下载次数: 6)

爱疯 · 发表于 2014-12-22 18:28

Private Sub CommandButton1_Click()
Dim A, B, C, d, i%, j%, k%, s1, t, s2
A = Sheets(2).UsedRange
ReDim B(1 To UBound(A), 1 To UBound(A, 2))
Set d = CreateObject("scripting.dictionary")
For k = 1 To UBound(A, 2) Step 11
      '字典录入
      d.RemoveAll
      For i = 1 To UBound(A)
         t = ""
         For j = k To k + 9
            t = t & "," & A(i, j)
         Next j
         d(t) = d(t) + 1
      Next i
      '给输出数组B赋值
      s1 = 0
      For Each t In d.keys
         If d(t) = 1 Then
            s1 = s1 + 1: s2 = 0
            C = Split(t, ",")
            For j = k To k + 9
                  s2 = s2 + 1
                  B(s1, j) = C(s2)
            Next j
         End If
      Next
Next k
Sheets(3).UsedRange = ""
Sheets(3).Range("a1").Resize(UBound(B), UBound(B, 2)) = B
End Sub

删除表格里所相同的行2.rar (28.81 KB, 下载次数: 6)

		自动登录	找回密码
密码			注册