我们如何更新重复行然后使用vba将其删除？

Question

VBA新手，并得到了我需要的90％的方式，但我无法弄清楚最后的部分。对于最后一步，我有一个来自A：K的数据范围，其中A包含一个唯一的数字。此数据的更新版本粘贴在初始范围以下，列A中的数字保持不变，但B：K正在更新。

我该如何复制下面的重复行，将其粘贴在原来的上面，然后删除重复？

Sub TEST2() 
' 
' TEST2 Macro 
' 

' Sheets("Sheet1").Select 
ActiveSheet.Range("A1:K1").Select 
Selection.AutoFilter 
ActiveSheet.Range("$A$1:$L$20").AutoFilter Field:=8, Criteria1:="red" 
Range("a2").Select 

Dim LR As Long 
LR = Range("A" & Rows.Count).End(xlUp).Row 
Range("A2:K" & LR).SpecialCells(xlCellTypeVisible).Select 

Selection.Copy 
Sheets("Sheet2").Select 
Range("A2").Select 
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 

ActiveSheet.Range("A1:l100").RemoveDuplicates Columns:=Array(1, 1), Header:=xlYes 


End With 
Range("$q$1").Select 
Selection.Copy 
Range("H2:H1000").Select 
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ 
SkipBlanks:=False, Transpose:=False 


Sheets("Sheet1").Select 
Worksheets("Sheet1").ShowAllData 
Range("O3").Select 

Sheets("Sheet2").Select 
Range("O3").Select 

End Sub 

此刻，我只能得到尽可能使用这个来删除重复项。表单中还有其他元素需要这样做。 在此先感谢您的帮助！

Answer 1

看到的问题后

首先想到的......它比一行多一点：

Dim i as integer, LR as Long 
LR = Cells(Rows.Count, "A").End(xlUp).Row 

For i = 2 to LR 'Assumes that row 1 is headers 
    If Application.Match(Cells(i,1),Range(Cells(2,1),Cells(i-1,1)),0)>0 Then 
     Rows(i).Cut 
     Rows(Application.Match(Cells(i,1),Range(Cells(2,1),Cells(i-1,1)),0)+1).PasteSpecial xlPasteValues 
     Else 
     End If 
    Next i 

编辑：它不顺心的范围;我会尝试清理它，然后使用插入/删除...请记住，如果我们使用任何行的删除，则需要将该步骤反转，以避免出现问题。见的变化下面，指出Ĵ加入：

Dim i As Integer, j As Integer, LR As Long 
LR = Cells(Rows.Count, "A").End(xlUp).Row 

For i = LR To 3 Step -1 'Assumes that row 1 is headers 
    If Application.IfError(Application.Match(Cells(i, 1), Range(Cells(2, 1), Cells(i - 1, 1)), 0), 0) > 0 Then 
     j = Application.Match(Cells(i, 1), Range(Cells(2, 1), Cells(i - 1, 1)), 0) 
     Range(Cells(i, 1), Cells(i, 11)).Cut 
     Range(Cells(j + 1, 1), Cells(j + 1, 11)).Insert xlShiftDown 
     Range(Cells(j + 2, 1), Cells(j + 2, 11)).Delete 
     End If 
    Next i 

Answer 2

可以使用以下算法（如以下示出的示例）： -

1. 创建一列以存储顺序号用于排序通用

2. 执行排序，以便最新的附加行始终位于顶部。 Excel的removeduplication函数将始终保持遇到的第一个唯一值

3. 完成后，您可以执行排序以重新排序数据行。

下面是一个示例代码，您需要根据您的实际数据集进行修改。

Sub Test() 

    LastRow = Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row 
    Range("L1").Value = LastRow 
    Range("L2").Value = LastRow - 1 
    Range("L1:L2").AutoFill Destination:=Range("L1:L" & LastRow) 
    Range("A1:L" & LastRow).Sort Order1:=xlAscending, Key1:=Range("L1"), Header:=xlNo 
    Range("A1:L" & LastRow).RemoveDuplicates Columns:=Array(1, 1), Header:=xlNo 

End Sub