我正在尝试从底部开始擦除重复的行,但它无法正常工作。它保留两个副本但删除其他重复项。
With wb_DST.Sheets(sWs_DST)
lncheckduplicatescolumn = .Cells(.Rows.Count, "A").End(xlUp).row
wb_DST.Sheets(sWs_DST).Range(("A13:A" & lncheckduplicatescolumn - 2 & ":" & "AW13:AW" & lncheckduplicatescolumn - 2)).Sort key1:=wb_DST.Sheets(sWs_DST).Range("A13:A" & lncheckduplicatescolumn - 2), order1:=xlDescending, Header:=xlNo
Dim row As Range
Dim rng As Range
Dim cell As Range
Dim i As Integer
Set rng = wb_DST.Sheets(sWs_DST).Range("A13:A" & lncheckduplicatescolumn - 2)
For Each cell In rng
If cell.Value = cell.Offset(-1, 0).Value Then
.cell.Offset(-1, 0).EntireRow.Delete
End If
Next
End with
如果Excel显示
Column A Column B
A 1
A 2
A 3
我希望代码保留最后一行,并删除它上面的代码。
结果应为
Column A Column B
A 3
谢谢,
答案 0 :(得分:1)
从下往上工作并循环直到所有更高的' (即连续小于当前的行)被删除。
dim dup as variant, r as long, lncheckduplicatescolumn as long
With wb_DST.Sheets(sWs_DST)
lncheckduplicatescolumn = .Cells(.Rows.Count, "A").End(xlUp).row
for r = lncheckduplicatescolumn to 2 step -1
dup = application.match(.cells(r, "A").value, .columns(1), 0)
if dup < r then .rows(dup).delete
next r
end with
这将需要比绝对必要的更多周期,但操作足够有效,不会产生显着差异。
答案 1 :(得分:0)
Dim x as integer
Dim y as string
Dim J as integer
Dim I as integer
x = activesheet.range("A" & Activesheet.range("A1").endxl.down).count 'This will count the total number of rows.
for i = x to 2 'this should count backwards from bottom to top, since you have headers, stop at row 2
y = Activesheet.range("A" & i).value 'places value in a variable
For j = x - i - 1 to 1 'this is another loop, but it should start above the whatever the cell that Y got its value
if activesheet.range("a" & j).value = y then 'comparison
'do what you need to delete the row
end if
Next
Next
我认为这将从底部开始,将第一个值放在变量中,然后将通过列表的其余部分检查值以查看是否兼容。可能需要调整第二个for循环。
答案 2 :(得分:0)
不是一个漂亮的答案 - 但从它的外观来看,你应该以最后一次和第一次出现的副本结束:
Column A Column B
A 1
A 3
要修改你的答案(有更优雅的方法),你可以在循环结束后再次找到最后一行并检查最后一个副本:
For Each cell In rng
If cell.Value = cell.Offset(-1, 0).Value Then
.cell.Offset(-1, 0).EntireRow.Delete
End If
Next
重新定义您的最后一行
lncheckduplicatescolumn = .Cells(.Rows.Count, "A").End(xlUp).row
并再检查一次
If Range("A" & lncheckduplicatescolumn).Value = Range("A" & lncheckduplicatescolumn).Offset(-1, 0).Value Then
.cell.Offset(-1, 0).EntireRow.Delete
End If