VBA 字符串的分部去重并组合

gwjkkkkk

参与一下
Sub TEST()
    Dim arr, brr, crr(), i&, j&, R&, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    arr = [B3].CurrentRegion.Resize(, 2)
    For i = 1 To UBound(arr)
      dic.RemoveAll: R = 0
      brr = Split(arr(i, 1))
      For j = 0 To 2
         dic(brr(j)) = ""
      Next j
      crr = dic.keys: bsort1 crr, 0, UBound(crr): arr(i, 1) = Join(crr)
      Erase crr
      For j = 3 To UBound(brr)
         If Not dic.exists(brr(j)) Then
            R = R + 1
            ReDim Preserve crr(1 To R)
            crr(R) = brr(j)
         End If
      Next j
      arr(i, 2) = Join(crr)
    Next i
    [F1].CurrentRegion.Offset(2).ClearContents
    [F3].Resize(UBound(arr), 2) = arr
    Set dic = Nothing
    Beep
End Sub
Function bsort1(arr, first, last, Optional order As Boolean = True)
  Dim i, j, k, t
  For i = first To last - 1
    For j = first To last + first - 1 - i
      If arr(j) <> arr(j + 1) Then
        If arr(j) < arr(j + 1) Xor order Then
            t = arr(j): arr(j) = arr(j + 1): arr(j + 1) = t
        End If
      End If
  Next j, i
End Function

gwjkkkkk

请参考 附件。。。

gwjkkkkk

理解有误，请参考下面的附件。。。

yhy95331

gwjkkkkk 发表于 2022-11-24 20:34
理解有误，请参考下面的附件。。。

感谢gwjkkkkk大师，从不同角度阐释同一问题，几位大师的代码又够消化一阵了

kuangben8

前三个数字去重排序：
=TEXTJOIN(" ",1,SORT(UNIQUE(--TEXTSPLIT(LEFT(B3,5)," "),1),,,1))
后10个数字去重排序：
=TEXTJOIN(" ",1,SORT(IF(ISERROR(FIND(--TEXTSPLIT(RIGHT(B3,19)," "),LEFT(B3,5))),--TEXTSPLIT(RIGHT(B3,19)," "),""),,,1))