老师能写个排序去重分列

不可说7625

把P列的数字，在Q列升序排列，并去重


比如
1、P3=45114，在Q3后面排序，并去重，1 4 5
以此类推


2、把后面得出的数字分别对比J到O里面的数字，相同的填充红色。
比如，Q3=1。1对比J到O里面的数字，相同的填充红色



3、弄个按钮运行。
谢谢。

liulang0808

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    Set Rng = Nothing
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    r = Cells(Rows.Count, "p").End(3).Row
    arr = [a1].Resize(r, 16)
    For j = 3 To r
        d.RemoveAll
        If Len(arr(j, 16)) > 0 Then
            For i = 1 To Len(arr(j, 16))
                d(Val(Mid(arr(j, 16), i, 1))) = ""
            Next i
        End If
        If d.Count = 1 Then
            Cells(j, 17) = d.keys()(0)
            d(d.keys()(0)) = 0
        Else
            brr = d.keys
            Call sort(d, brr)
            Cells(j, 17).Resize(1, d.Count) = brr
        End If
        For i = 10 To 15
            If d.exists(Val(arr(j, i))) Then
               
                Union(Cells(j, i), Cells(j, 17 + d(arr(j, i)))).Interior.ColorIndex = 3
            End If
        Next i
    Next j

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub
Sub sort(d, arr)
    For j = LBound(arr) To UBound(arr)
        x = WorksheetFunction.Small(d.keys, j + 1)
        arr(j) = x
        d(x) = j
    Next j
End Sub

liulang0808

测试0104.zip (29.92 KB, 下载次数: 14)

2024-1-4 20:41 上传

点击文件名下载附件

附件内容供参考。。。。

剑指E

不可说7625

剑指E 发表于 2024-1-4 20:45

老师，QRS里面相同的也要填充红色。

剑指E

不可说7625 发表于 2024-1-4 20:57
老师，QRS里面相同的也要填充红色。

、               

liulang0808

测试0104.zip (1.41 MB, 下载次数: 14)

2024-1-4 21:37 上传

点击文件名下载附件

不可说7625

liulang0808 发表于 2024-1-4 21:37

老师，序号2805这期，显示不对，是哪不对？

不可说7625

liulang0808 发表于 2024-1-4 21:37

老师，新的这期，显示不对，是哪不对？

不可说7625

剑指E 发表于 2024-1-4 21:32
、

老师，有个问题，我在W、X列编写了公式，运行按钮会清除这些公式。能麻烦在修改下，保留我后面编写的公式，又不影响前面的更新