Question

我是vba的新手，早些时候在这里遇到过一些与vba宏有关的问题的帮助，现在我又需要帮助了。

我有一个包含大量数据的excel文件，我在S列中有大量重复的EAN编号，我想删除所有重复的EAN（包含重复的整个行）但保留价格最低的那个（列Q）），所以我想比较S列中的重复EAN，并根据Q栏中的最低价格删除所有重复项，并保留最便宜的一个。它有很多数据，超过10000行，所以通过formel手动执行此操作不是最好的方法，需要很多时间手动删除这些行。

下面的示例（第一个是价格，第二个应该是ean）：

104,93 - 000000001
104.06 - 000000001
104.94 - 000000001

在这种情况下，我想删除第一行和第三行并保留第二行，任何人都知道宏应该是什么样子，我使用Excel 2010？

Answer 1

这可能会对你有帮助。

我假设你有一个标题行。如果不是，请将iHeaderRowIndex更改为0.

第一部分创建一个字典对象，收集所有唯一的EAN编号，并为每个EAN分配一个非常高的价格（1000万）

然后它重新扫描列表，这次是一个“MIN”逻辑来确定每个EAN的最低价格。

另一次重新扫描，这次它在每个min EAN旁边的空闲列中放置一个MIN标记（你应该选择一个空闲列的名称 - 我输入“W”但你可以改变它）

最后，它以相反的顺序重新扫描列表，删除所有没有MIN标记的行。此外，最后，它会删除带有MIN标记的列。

Public Sub DoDelete()
Dim oWS As Worksheet
Dim d As Object, k As Object
Dim a As Range
Dim b As Range
Dim sColumnForMarking As String
Dim iHeaderRowIndex As Integer
Dim i As Integer
Dim iRowsCount As Integer
Dim v As Double


Set oWS = ActiveSheet
Set d = CreateObject("scripting.dictionary")

' ----> Put here ZERO if you do not have a header row !!!
iHeaderRowIndex = 1
' ----> Change this to what ever you like. This will be used to mark the minimum value.
sColumnForMarking = "W"

' Selecting the column "S"
Set a = _
oWS.Range(oWS.Cells(1 + iHeaderRowIndex, "S"), _
          oWS.Cells(ActiveSheet.UsedRange.Rows.Count, "S"))

' putting a high number, one that is beyond the max value in column Q
' ----> Change it if it is too low !!!!
For Each b In a
    d(b.Text) = 9999999   ' very high number, A max++ to all the prices
Next

For Each b In a
    v = CDbl(oWS.Cells(b.Row, "Q").Value)

    If v < CDbl(d(b.Text)) Then
        d(b.Text) = v
    End If
Next

For Each b In a
    v = CDbl(oWS.Cells(b.Row, "Q").Value)

    If v = CDbl(d(b.Text)) Then
        oWS.Cells(b.Row, sColumnForMarking).Value = "MIN"
    End If
Next


' This part deletes the lines that are not marked as "MIN".

iRowsCount = oWS.UsedRange.Rows.Count

Application.ScreenUpdating = False

For i = iRowsCount To iHeaderRowIndex + 1 Step -1
    If oWS.Cells(i, sColumnForMarking).Text <> "MIN" Then
        oWS.Rows(i).Delete Shift:=xlShiftUp
    End If
Next

' clean up- deletes the mark column
oWS.Columns(sColumnForMarking).EntireColumn.Delete

Application.ScreenUpdating = True    
End Sub

VBA：根据Q列中的最低价格删除S列中的重复条目（行）

1 个答案: