[已解决]复制多个工作表中不重复的行

ww0000 · 发表于 2012-7-8 12:12

以下代码是复制多个工作表中不重复的姓名。我现在想改成复制姓名栏不重复的行，代码怎么改，谢谢

拷贝多个工作表中不重复的行.rar (9.91 KB, 下载次数: 31)

gdsgzhrsh · 发表于 2012-7-8 12:31

姓名栏不重复，还是整行不重复？

ww0000 · 发表于 2012-7-8 12:49

只要姓名栏不重复

ww0000 · 发表于 2012-7-8 12:58

以下是针对一个工作表的提取不重复行，怎样才能历遍多个工作表？
Sub 拷贝C列重复行1()
Dim i As Long
Application.ScreenUpdating = False
point = 1
num = Range("A65536").End(xlUp).Row
For i = 1 To num
If WorksheetFunction.CountIf(Range("A1:A" & i), Cells(i, 1)) = 1 Then
Cells(i, 1).EntireRow.Copy Sheets("Sheet3").Cells(point, 1)
point = point + 1
End If
Next
Application.ScreenUpdating = True
End Sub

dongqing1998 · 发表于 2012-7-8 12:58

本帖最后由 dongqing1998 于 2012-7-8 13:06 编辑

Sub bcfz()
Dim i&, Myr&, Arr, brr()
Dim d, k, t, Sht As Worksheet
Set d = CreateObject("Scripting.Dictionary")
For Each Sht In Sheets
If Sht.Name <> "Sheet4" Then
Myr = Sht.[a65536].End(xlUp).Row
Arr = Sht.Range("a2:c" & Myr)
For i = 1 To UBound(Arr)
d(Arr(i, 1)) = Arr(i, 2) & "," & Arr(i, 3)
Next
End If
Next
k = d.keys
ReDim Preserve brr(0 To d.Count, 1 To 3)
brr(0, 1) = "姓名": brr(0, 2) = "学号": brr(0, 3) = "分数"
For i = 1 To d.Count
brr(i, 1) = k(i - 1)
brr(i, 2) = Split(d(k(i - 1)), ",")(0)
brr(i, 3) = Split(d(k(i - 1)), ",")(1)
Next
Sheet4.[a3].Resize(d.Count + 1, 3) = brr
Set d = Nothing
End Sub

复制代码

上面是根据你的代码修改的。
PS:因为你每个姓名对应的B、C两列数据并不完全统一，所以得到的结果只是你最后一次出现的

周义坤 · 发表于 2012-7-8 13:10

本帖最后由周义坤于 2012-7-8 13:12 编辑

Sub ek_sky()
Dim arr1, arr2(1 To 10000, 1 To 1), a, b
Dim i&, j&, k&
Dim d1 As Object
Set d1 = CreateObject("Scripting.Dictionary")
For i = 1 To Sheets.Count
If Sheets(i).Name <> "sheet4" Then
Set a = Sheets(i)
b = a.Range("A2:A" & a.Cells(Rows.Count, 1).End(3).Row)
For j = 1 To UBound(b)
k = k + 1
arr2(k, 1) = b(j, 1)
d1(arr2(k, 1)) = ""
Next j
End If
Next i
With Sheets("sheet4")
.Range("A:A").ClearContents
.Range("A3").Resize(d1.Count) = Application.Transpose(d1.keys)
End With
End Sub

复制代码

ww0000 · 发表于 2012-7-8 13:15

dongqing1998 发表于 2012-7-8 12:58
上面是根据你的代码修改的。
PS:因为你每个姓名对应的B、C两列数据并不完全统一，所以得到的结果只是你最后 ...

这样格式不能复制过来呀？
再问，上面第二个代码如何历遍多个工作表呀》？谢谢！

ww0000 · 发表于 2012-7-8 13:19

周义坤发表于 2012-7-8 13:10

版主的还是只复制姓名栏呀？我要的是复制姓名栏不重复的整个行。谢谢！

zjdh · 发表于 2012-7-8 13:48

本帖最后由 zjdh 于 2012-7-8 14:01 编辑

Sub 拷贝A列不重复行1()
Dim i As Long
Application.ScreenUpdating = False
Point = 2
For Each sh In Sheets
      If sh.Name <> "Sheet4" Then
         With sh
            For i = 2 To .Range("A65536").End(xlUp).Row
                  If WorksheetFunction.CountIf(.Range("A1:A" & i), .Cells(i, 1)) = 1 Then
                     .Cells(i, 1).EntireRow.Copy Sheets("Sheet4").Cells(Point, 1)
                     Point = Point + 1
                  End If
            Next
         End With
      End If
Next
Application.ScreenUpdating = True
End Sub

zjdh · 发表于 2012-7-8 14:01

拷贝多个工作表中不重复的行.rar (10.05 KB, 下载次数: 28)

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