如何将重复的行移动到Excel中的另一个工作表？

Sub CutDuplicates() Updateby Extendoffice Dim xRgS As Range Dim xRgD As Range Dim I As Long, J As Long On Error Resume Next Set xRgS = Application.InputBox("Please select the column:", "KuTools For Excel", Selection.Address, , , , , 8) If xRgS Is Nothing Then Exit Sub Set xRgD = Application.InputBox("Please select a desitination cell:", "KuTools For Excel", , , , , , 8) If xRgD Is Nothing Then Exit Sub xRows = xRgS.Rows.Count J = 0 For I = xRows To 1 Step -1 If Application.WorksheetFunction.CountIf(xRgS, xRgS(I)) > 1 Then xRgS(I).EntireRow.Copy xRgD.Offset(J, 0) xRgS(I).EntireRow.Delete J = J + 1 End If Next End Sub

Sub CutDuplicates() Updateby Extendoffice Dim xRgD As Range, xRgS As Range Dim I As Long, J As Long, K As Long, KK As Long On Error Resume Next Set xRgS = Application.InputBox("Please select the data range:", "KuTools For Excel", Selection.Address, , , , , 8) If xRgS Is Nothing Then Exit Sub Set xRgD = Application.InputBox("Please select a desitination cell:", "KuTools For Excel", , , , , , 8) If xRgD Is Nothing Then Exit Sub KK = 0 For I = xRgS.Rows.Count To 1 Step -1 For J = 1 To I - 1 For K = 1 To xRgS.Columns.Count Debug.Print xRgS.Rows(I).Cells(, K).Value Debug.Print xRgS.Rows(J).Cells(, K).Value If xRgS.Rows(I).Cells(, K).Value <> xRgS.Rows(J).Cells(, K).Value Then Exit For Next If K = xRgS.Columns.Count + 1 Then xRgS.Rows(I).EntireRow.Copy xRgD.Offset(KK, 0).EntireRow xRgS.Rows(I).EntireRow.Delete KK = KK + 1 End If Next Next End Sub

最佳办公生产力工具

在Word，Excel，PowerPoint中启用选项卡式编辑和阅读，发布者，Access，Visio和Project。 在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。 每天将您的工作效率提高50％，并减少数百次鼠标单击！