我们如何更新重复的行，然后使用vba删除它？

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 

编辑：它不喜欢的范围; 我会尝试清理它，然后使用插入/删除…请记住，如果我们使用删除任何行，你会想要扭转的步骤，以避免问题。 看到下面的变化，注意到j被添加：

 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

您可以使用下面的algorithm（以下示例）： –

1. 创build一个列来存储序号，以便进行sorting

2. 执行sorting，以便最新的附加行总是在最上面。 Excel的removeduplication函数将始终保持第一个遇到的唯一值

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

以下是您需要根据实际数据集修改的示例代码。

 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