时间戳

首页 > 解决方案 > VBA 宏根据相邻值删除重复项及其相邻单元格

excel - VBA 宏根据相邻值删除重复项及其相邻单元格

问题描述

我一直在尝试编写一个宏来删除基于相邻值的重复单元格/行。我的意思是我只需要具有最低值邻居的单元格留下来，fe

1|1

2|1

1|2

1|0

然后

2|1

1|0

我知道 Range.RemoveDuplicates 函数，但是我不能在这里以正确的方式使用它。我的代码有点直截了当，它并不总是删除所有重复项。我是 VBA 的新手，所以也许是因为我无法真正理解输出的来源。我的代码：

Sub usunDuplikaty3()

Dim findRange As Range, foundCell As Range, cell As Range, del As Boolean
    Set findRange = Range("A1", Range(Range("A1").End(xlDown).Address))
    For Each cell In findRange
        Set foundCell = findRange.Find(cell.Value)
        Do While Not foundCell Is Nothing And foundCell.Address <> cell.Address
            If foundCell.Offset(0, 1).Value <= cell.Offset(0, 1).Value Then
                Rows(cell.Row).Delete (xlShiftUp)
                Set cell = foundCell
                Set findRange = Range("A1", Range(Range("A1").End(xlDown).Address))
            Else
                Rows(foundCell.Row).Delete (xlShiftUp)
                Set findRange = Range("A1", Range(Range("A1").End(xlDown).Address))
            End If
        Loop
    Next
    
End Sub

知道我在做什么错吗？

标签： excelvba

解决方案

我会尝试不同的方法。您可以使用MINIFS检查B值是否为对应A值的最小值，如果不是，则删除。此代码在最后进行删除，这更容易，因为它避免了丢失的行，并且在你去的时候也重新计算了最小值。

Sub usunDuplikaty3()

Dim findRange As Range, cell As Range, rDel As Range

Set findRange = Range("A1", Range("A" & Rows.Count).End(xlUp)) 'better to work up from the bottom

For Each cell In findRange
    If cell.Offset(, 1).Value <> WorksheetFunction.MinIfs(findRange.Offset(, 1), findRange, cell.Value) Then
    'alternative avoiding MINIFS
    'If cell.Offset(, 1).Value <> Evaluate("Min(If(" & findRange.Address & "=" & cell.Value & "," & findRange.Offset(, 1).Address & "))") Then
      If rDel Is Nothing Then
            Set rDel = cell
        Else
            Set rDel = Union(cell, rDel)
        End If
    End If
Next
    
If Not rDel Is Nothing Then rDel.EntireRow.Delete

End Sub

推荐阅读