Попытка удалить определенные повторяющиеся значения в Excel - PullRequest
Новая
       75

Попытка удалить определенные повторяющиеся значения в Excel

0 голосов
/ 31 мая 2018

У меня есть набор данных заказов, которые связаны между собой первичным ключом (номером партии).Однако номера заказов имеют маркировку поля, если они были вовремя или поздно.Если один номер заказа помечен поздно, весь номер партии должен быть помечен как поздний, а затем удалите дублирующиеся номера партий.Я хочу сделать это в 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

Большое спасибо за любую помощь, которую вы можете предоставить.

1 Ответ

0 голосов
/ 31 мая 2018

Подобно этому, используя справочную таблицу 

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

Данные

data

С 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
...