0

我有一组由主键（批号）链接的订单数据集。但是，订单号有一个字段标记，如果他们准时或迟到。如果一个订单号被标记为延迟，则整个批号应标记为延迟，然后删除重复的批号。我希望在 excel、公式或 VBA 中执行此操作。

IE。开始结果

   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

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

4

1 回答 1

0

像这样使用参考表

=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 隐藏行，但对于任何给定的批号，除了延迟的第一个实例（如果存在任何延迟）或准时（如果都准时）之外的行。

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
于 2018-05-31T18:05:10.860 回答