Удалить дубликаты без смещения клеток

Question

У меня есть лист Excel с 2 столбцами, один содержит название проблемы на компьютере, а другой - объединенные серийные номера компьютеров с этой проблемой.Цель таблицы Excel - найти лучшую комбинацию проблем, которые необходимо исправить в приоритетном порядке, то есть наиболее распространенную комбинацию проблем в компьютерном парке. Вот пример данных:

Issue          Serials
Dead SSD     SN0125;
Dead CPU     SN0125;SN0452;
Dead Screen  SN0785;SN0452;SN0125;
Dead Ram     SN0785;SN0452;SN0658;SN0125;SN0111

Это означает, что SN0125 будетможно использовать повторно после того, как мы исправили его SSD, а SN0111 можно будет повторно использовать после того, как мы исправили его оперативную память, экран, процессор и SSD.Как вы можете видеть, в конкатенации сериалов нет ни шаблона, ни порядка.

Что я хочу, так это если серийный номер появляется в ряду, он не должен появляться в строках под ним, поэтому яполучить что-то вроде этого.

Issue          Serials
    Dead SSD     SN0125;
    Dead CPU     SN0452;
    Dead Screen  SN0785;
    Dead Ram     SN0658;SN0111;

Я пытался циклически проходить по строкам и удалять дубликаты сериалов, используя замену, но в итоге я получил пустые серийные ячейки и не мог понять, почему.Вот код, который я попробовал:

    For i = 2 To las_row
    s1 = Cells(i, 2)

    For j = i To las_row
    'We look for the content of the previous row, inside the next and remove it
    s2 = Cells(j, 2)
    Cells(i, 2) = Replace(s1, s2, "")
    Next j
    Next i

Если бы кто-нибудь мог мне помочь, я был бы очень благодарен!

Answer 1

Вариант с использованием split() и Scripting.Dictionary:

Sub test()
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    dic.comparemode = vbTextCompare
    Dim cl As Range, data As Range, x As Variant

    Set data = Range([B2], Cells(Rows.Count, 2).End(xlUp))

    For Each cl In data
        For Each x In Split(cl.Value2, ";")
            If dic.exists(x) Then
                cl.Value2 = Replace(cl.Value2, x & ";", "")
            Else
                dic.Add x, Nothing
            End If
        Next x
    Next cl
End Sub

тест

Answer 2

Разделите значение ячейки и найдите совпадение по шаблону над текущей строкой.

Option Explicit

Sub prioritize()

    Dim m As Variant, arr As Variant, r As Long, i As Long, str As String

    With Worksheets("sheet1")

        For r = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
            'split the cell value on a semi-colon delimiter
            arr = Split(.Cells(r, "B").Value2, Chr(59))

            'look for a previous match
            For i = LBound(arr) To UBound(arr)
                m = Application.Match(Chr(42) & arr(i) & Chr(42), .Columns("B"), 0)
                If m < r Then arr(i) = vbNullString
            Next i

            'put the array back together then repair it and put it into the cell
            str = Join(arr, Chr(59))
            Do While InStr(1, str, Chr(59) & Chr(59)) > 0: str = Replace(str, Chr(59) & Chr(59), Chr(59)): Loop
            Do While Left(str, 1) = Chr(59): str = Mid(str, 2): Loop
            Do While Right(str, 1) = Chr(59): str = Left(str, Len(str) - 1): Loop
            .Cells(r, "B") = str
        Next r

    End With
End Sub