Question

我有一个包含2列的excel工作表，其中一列包含一台计算机上的问题的名称，另一列包含此问题的计算机的串联序列号。 Excel工作表的重点是找到优先解决的最佳问题组合，即计算机园区中最新的问题组合这是一个数据示例：

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

这意味着SN0125在修复了固态硬盘后将可重用，而SN0111在修复了ram，屏幕，CPU和SSD后将可重用。如您所见，串行连接中没有任何模式或顺序。

我想要的是，如果连续显示一行，那么它不应该出现在他下面的行中，所以我得到了类似的东西。

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

我尝试遍历行并使用replace删除重复的序列，但最终却得到了空的串行单元，无法弄清原因。这是我尝试的代码：

    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

拆分单元格的值，并在当前行上方查找通配符。

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

Answer 2

使用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

测试

删除重复项而不移动单元格

2 个答案: