尝试删除excel中的某些重复值

Question

我有一个订单数据集，这些订单都是通过主键（批号）链接的。但是，如果订单编号准时或延迟，则订单编号会有字段标记。如果延迟标记一个订单号，则应将整批编号标记为延迟，然后删除重复的批次编号。我希望在excel，公式或VBA中做到这一点。

即。开始结果

   Batch Number      order Number     Late?
   1234              1                Late
   1234              2                Late
   1234              3                On Time
   5678              4                On Time
   5678              5                On Time
   5678              6                On Time

结束结果

   Batch Number      order Number     Late?
   1234              2                Late
   5678              4                On Time

非常感谢您提供任何帮助。

Answer 1

像这样使用参考表

=IF(SUMPRODUCT(--($A$2:$A$7=$E2),--($C$2:$C$7="LATE"))>0,"LATE","On time")

数据

使用VBA 替换现有值并返回唯一行：

<强>代码：

Option Explicit

Public Sub test()
    Dim ws As Worksheet, rng As Range, key As Variant, dataRange As Range, dict As Object
    Set ws = ThisWorkbook.Worksheets("Sheet2")
    Set dict = CreateObject("Scripting.Dictionary")
    Set dataRange = ws.Range("A2:C7")

    Application.ScreenUpdating = False
    For Each rng In dataRange.Columns(1).Cells
        If Not dict.exists(rng.Value) Then
            dict.Add rng.Value, rng.Value
        End If
    Next rng

    For Each key In dict.keys
        If Application.WorksheetFunction.CountIfs(dataRange.Columns(1), key, dataRange.Columns(3), "Late") > 0 Then
            dict(key) = "Late"
        Else
            dict(key) = "On Time"
        End If
    Next key

    With dataRange
        .ClearContents
        .Cells(1, 1).Resize(dict.Count) = Application.WorksheetFunction.Transpose(dict.keys)
        .Cells(1, 3).Resize(dict.Count) = Application.WorksheetFunction.Transpose(dict.items)
    End With
    Application.ScreenUpdating = True

End Sub

版本2要隐藏除Late的第一个实例以外的行（如果有任何迟到的话），或者对于任何给定的批次编号，如果所有的On Time，则为On Time。

Option Explicit

Public Sub test2()
    Dim ws As Worksheet, rng As Range, key As Variant, dataRange As Range, dict As Object
    Set ws = ThisWorkbook.Worksheets("Sheet2")
    Set dict = CreateObject("Scripting.Dictionary")
    Set dataRange = ws.Range("A2:C7")

    Application.ScreenUpdating = False
    For Each rng In dataRange.Columns(1).Cells
        If Not dict.exists(rng.Value) Then
            dict.Add rng.Value, rng.Value
        End If
    Next rng

    dataRange.EntireRow.Hidden = True

    For Each key In dict.keys
        If Application.WorksheetFunction.CountIfs(dataRange.Columns(1), key, dataRange.Columns(3), "Late") > 0 Then
            dict(key) = "Late"
            ActiveSheet.Cells(GetRowNumber(dataRange.Columns(3), key, "Late"), 1).EntireRow.Hidden = False
        Else
            dict(key) = "On Time"
            ActiveSheet.Cells(GetRowNumber(dataRange.Columns(3), key, "On Time"), 1).EntireRow.Hidden = False
        End If
    Next key

    Application.ScreenUpdating = True

End Sub

Public Function GetRowNumber(ByRef rng As Range, ByVal key As Long, ByVal searchTerm As String) As Long
    Dim currentRng As Range
    For Each currentRng In rng.Rows
        If currentRng.Value = searchTerm And currentRng.Offset(, -2) = key Then
            GetRowNumber = currentRng.Row
            Exit Function
        End If
    Next currentRng
End Function