Option Explicit
'Функция по мотивам СцепитьМного (для несмежных диапазонов) от Дмитрия Щербакова
'===================================================================================================================================================================================================
Public Function PRDX_Merge(WF_rng As Range, Optional WF_delim As String = "—", Optional WF_uniq As Boolean = False, Optional WF_NoDash As Boolean = True) As String
Dim WF_area As Range
Dim WF_arr
Dim WF_lr&, WF_lc&
Dim WF_temp$
    
On Error GoTo er
    For Each WF_area In WF_rng.Areas
        WF_arr = WF_area.Value
        If Not IsArray(WF_arr) Then
            ReDim WF_arr(1 To 1, 1 To 1)
            WF_arr(1, 1) = WF_area.Value
        End If
      
        For WF_lc = 1 To UBound(WF_arr, 2)
            For WF_lr = 1 To UBound(WF_arr, 1)
                If (Len(WF_arr(WF_lr, WF_lc)) = 0) Or (WF_NoDash = True And WF_arr(WF_lr, WF_lc) = Chr(151)) Then GoTo nx:
            WF_temp = WF_temp & WF_delim & WF_arr(WF_lr, WF_lc)
nx:
            Next WF_lr
        Next WF_lc
    Next WF_area
    If Len(WF_temp) Then
        WF_temp = Mid(WF_temp, Len(WF_delim) + 1)
    End If
       
    If WF_uniq = True Then
        Dim oDict As Object, sTmpStr
        Set oDict = CreateObject("Scripting.Dictionary")
        sTmpStr = Split(WF_temp, WF_delim)
        On Error Resume Next
        For WF_lr = LBound(sTmpStr) To UBound(sTmpStr)
            oDict.Add sTmpStr(WF_lr), sTmpStr(WF_lr)
        Next WF_lr
        WF_temp = ""
        sTmpStr = oDict.Keys
        For WF_lr = LBound(sTmpStr) To UBound(sTmpStr)
            WF_temp = WF_temp & IIf(WF_temp <> "", WF_delim, "") & sTmpStr(WF_lr)
        Next WF_lr
    End If
PRDX_Merge = WF_temp

GoTo fin
er:
PRDX_Merge = ""

fin:
On Error GoTo 0
End Function