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

编辑：它不喜欢这个范围;我会尝试清理它，然后使用插入/删除...请记住，如果我们对任何行使用删除，您将要反转该步骤，以避免问题。请参阅以下更改，注意添加了 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

您可以使用以下算法（如下图所示）： -

创建一个列以存储序列号以进行排序
执行排序，以便最新添加的行始终位于顶部。 Excel的removeduplication函数将始终保持第一个遇到的唯一值
完成后，您可以执行排序以重新排序数据行。

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

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

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

2 个答案: