'Option Base 1
Option Explicit
'Option Private Module
'==================================================================================================
Function ConcatUniq(xRg As Range, xChar As String) As String
    Dim xCell As Range
    Dim x, s$, VT&, xDic As Object
    
    Set xDic = CreateObject("Scripting.Dictionary")
    
    For Each xCell In xRg
        VT = VarType(xCell.Value)
        If ((VT = vbEmpty) Or (VT = vbError)) Then GoTo nx
        
        s = xCell.Value
        If ((s = "") Or (s = "1")) Then GoTo nx

        x = xDic(s)
nx: Next xCell
    
    if (xDic.Count <> 0) Then ConcatUniq = Join$(xDic.Keys, xChar)
    Set xDic = Nothing
End Function
'==================================================================================================

Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Sub PRDX_SortRecur_WithInd(aV(), aI() As Long, LBnd&, UBnd&)
Dim i&, j&, n&, x, y

i = LBnd: j = UBnd: x = aV((LBnd + UBnd) \ 2)

Do
    While (aV(i) < x): i = i + 1: Wend
    While (x < aV(j)): j = j - 1: Wend
    If (i <= j) Then
        y = aV(i): aV(i) = aV(j): aV(j) = y
        n = aI(i): aI(i) = aI(j): aI(j) = n
        i = i + 1: j = j - 1
    End If
Loop Until (i > j)

If (LBnd < j) Then PRDX_SortRecur_WithInd aV, aI, LBnd, j
If (i < UBnd) Then PRDX_SortRecur_WithInd aV, aI, i, UBnd
End Sub
'==================================================================================================
Function PRDX_Sort_Arr2D_ByIndexes(a2D, aInd() As Long) As Variant()
Dim aNew(), i&, rNew&, c&

ReDim aNew(UBound(a2D, 1), UBound(a2D, 2))

For i = LBound(aInd) To UBound(aInd)
    rNew = rNew + 1
    For c = 1 To UBound(a2D, 2)
        aNew(rNew, c) = a2D(aInd(i), c)
    Next c
Next i

PRDX_Sort_Arr2D_ByIndexes = aNew
End Function
'==================================================================================================
Function PRDX_Sort_Arr2D(a2D, Optional ByVal nCol& = 1) As Variant()
Dim x, aVal(), aInd&(), r&, c&

ReDim aVal(UBound(a2D, 1)): ReDim aInd(UBound(aVal))

For r = 1 To UBound(aInd)
    aInd(r) = r: aVal(r) = a2D(r, nCol)
Next r

PRDX_SortRecur_WithInd aVal, aInd, 1, UBound(aInd)
PRDX_Sort_Arr2D = PRDX_Sort_Arr2D_ByIndexes(a2D, aInd)
End Function
'==================================================================================================
'==================================================================================================
'==================================================================================================
Private Sub TestSelection()
Dim rng As Range
Dim x
    Set rng = Selection: If (rng.Areas.Count <> 1) Then Exit Sub
    x = rng.Value: If Not IsArray(x) Then Exit Sub
    rng.Value = PRDX_Sort_Arr2D(x, 1)
End Sub
'==================================================================================================

Function PRDX_StatusBar_IsBusy_ByStrVal(ByVal ASB$) As Boolean
    ASB = LCase$(ASB)
    If ((ASB = "false") Or (ASB = "ложь")) Then Exit Function
    PRDX_StatusBar_IsBusy_ByStrVal = True
End Function
'--------------------------------------------------------------------------------------------------
Function PRDX_StatusBar_IsBusy() As Boolean
    PRDX_StatusBar_IsBusy = PRDX_StatusBar_IsBusy_ByStrVal(Application.StatusBar)
End Function
'--------------------------------------------------------------------------------------------------
Sub PRDX_StatusBar_Set(ASB$)
    If PRDX_StatusBar_IsBusy_ByStrVal(ASB) Then Application.StatusBar = ASB Else Application.StatusBar = False
End Sub