时间戳

首页 > 解决方案 > 使用 Excel VBA 删除相似行

excel - 使用 Excel VBA 删除相似行

问题描述

我正在尝试为 Excel 宏编写 VBA 代码，以便可以手动触发宏来执行以下操作：

如果任何两行有：

然后我希望删除所有这些行，除了 E 列中具有最高值的行。

例如，如果：

然后第 1 行被删除，第 2 行保留。

总体目标是删除相似的行。

根据用户的建议，可以通过按 c="apple",a,b,d 对范围进行排序来帮助/简化此过程，以便可以连续分析行。

代码结果示例

我将以下代码放在一起，但我不熟悉删除行方面以及如何合并最高值，但这是我最好的选择。If 和 elseif 语句是有问题的。

Sub Macro()

Dim a As Range
Dim b As Range
Dim c As Range
Dim d As Range
Dim e As Range

For Each a In Range("A1:A9999")

For Each b In Range("B1:B9999")

For Each c In Range("C1:C9999")

For Each d In Range("D1:D9999")

For Each e In Range("E1:E9999")

If a.Offset(-1, 0) = a And b.Offset(-1, 0) And c.Offset(-1, 0) = c And d.Offset(-1, 0) = d And e.Offset(-1, 0) < e Then Range(a).EntireRow.Delete

ElseIf a.Offset(-1, 0) = a And b.Offset(-1, 0) And c.Offset(-1, 0) = c And d.Offset(-1, 0) = d And e.Offset(-1, 0) > e Then Range(a.Offset(-1, 0)).EntireRow.Delete

Exit For

Next a

Next b

Next c

Next d

Next e

End Sub

标签： excelvba

解决方案

我希望它有效。

Option Explicit

Sub RunMacro()
Dim i As Long, LastRow As Long, j As Long
Dim cellA, cellB, cellC, cellD, cellE
Dim Rng As Range
LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastRow
cellA = Range("A" & i).Value
cellB = Range("B" & i).Value
cellC = Range("C" & i).Value
cellD = Range("D" & i).Value
cellE = Range("E" & i).Value

For j = LastRow To 2 Step -1
    If Range("A" & j).Value = cellA And Range("B" & j).Value = cellB Then
        If Range("C" & j).Value = cellC And Range("D" & j).Value = cellD Then                  

            If cellE > Range("E" & j).Value Then
                Range("E" & j).EntireRow.Delete
                LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

            End If

        End If
    End If
Next j
Next i
            LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
            With ActiveSheet
            Set Rng = Range("A1", Range("E1").End(xlDown))
            Rng.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes
            End With

End Sub

推荐阅读