Declare Function VarPtr Lib "msvbvm60" (variable As Any) As Long
Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long
Declare Function PutMem2 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValue As Long) As Long
Declare Function PutMem4 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValue As Long) As Long
Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long

Function JoinRange(srcRng As Range, Optional delim As String = "") As String
'Конкатенация для диапазона ячеек
Dim transformArray() As Variant, SA_Ptr As Long

     transformArray = srcRng
     'UnDim transformArray
     '--- Преобразуем 2-мерный массив в 1-мерный
     GetMem4 ArrPtr(transformArray), VarPtr(SA_Ptr) 'SA_Ptr = *SAFEARRAY
     PutMem2 SA_Ptr, 1 '.cDims = 1
     PutMem4 SA_Ptr + 16, srcRng.Cells.Count '.rgsabound(1).cElements = srcRng.Cells.Count
     '---
     JoinRange = Join(transformArray, delim)
End Function

Function СКЛЕИТЬ(Диапазон As Range, _
                   Optional Разделитель_Данных$ = "", _
                   Optional Переносить_ДА_НЕТ$ = "ДА") As String
'---------------------------------------------------------------------------------------
' Procedure    : СКЛЕИТЬ
' Author       : Alex_ST
' Purpose      : склеить тексты из выделенных ячеек в одну строку с задаваемыми при необходимости разделителями данных из разных ячеек
' Notes        : по умолчанию включен перенос строк внутри ячейки
'---------------------------------------------------------------------------------------
      Dim Слитый_Текст$, Перенос_Строки$, a, i&
      Перенос_Строки = IIf(UCase(Переносить_ДА_НЕТ) <> "НЕТ", vbLf, " ")
      a = Application.Trim(Диапазон.Value)
      If Диапазон.Rows.Count = 1 Then СКЛЕИТЬ = Join(a, Разделитель_Данных): Exit Function
      For i = 1 To UBound(a)
          Слитый_Текст = Слитый_Текст & Join(Application.Index(a, i, 0), Разделитель_Данных) & Перенос_Строки
      Next
      СКЛЕИТЬ = Left$(Слитый_Текст, Len(Слитый_Текст) - 1)
End Function

Function СКЛЕИТЬ$(ДИАПАЗОН As Range, _
                  Optional Разделитель$ = "", _
                  Optional Переносить As Boolean = True)
'---------------------------------------------------------------------------------------
' Procedure    : СКЛЕИТЬ
' Author       : Alex_ST
' Purpose      : склеить тексты из выделенных ячеек в одну строку с задаваемыми при необходимости разделителями данных
' Notes        : по умолчанию включен перенос строк внутри ячейки
'---------------------------------------------------------------------------------------
      Разделитель = Разделитель & IIf(Переносить, Chr(10), "")
      Dim Arr, i&
      Arr = Application.Trim(ДИАПАЗОН.Value)
      For i = 1 To UBound(Arr)
          СКЛЕИТЬ = СКЛЕИТЬ & IIf(Len(СКЛЕИТЬ), Разделитель, "") & Arr(i, 1)
      Next
End Function

СКЛЕИТЬ = join(Arr,Разделитель)

Function СКЛЕИТЬ$(ДИАПАЗОН As Range, _
                   Optional Разделитель$ = "", _
                   Optional Переносить As Boolean = True)
'---------------------------------------------------------------------------------------
' Procedure    : СКЛЕИТЬ
' Author       : Alex_ST
' Purpose      : склеить тексты из выделенных ячеек в одну строку с задаваемыми при необходимости разделителями данных
' Notes        : по умолчанию включен перенос строк внутри ячейки
'---------------------------------------------------------------------------------------
    Разделитель = Разделитель & IIf(Переносить, Chr(10), "")
    Dim Arr, xArr
    Arr = Application.Trim(ДИАПАЗОН.Value)
    For Each xArr In Arr
       If Len(xArr) Then СКЛЕИТЬ = СКЛЕИТЬ & IIf(Len(СКЛЕИТЬ), Разделитель, "") & xArr
    Next
End Function

Sub io()
     Dim html As Object
     Set html = CreateObject("htmlfile")
      
     html.write ("<script src=""http://code.jquery.com/jquery-1.8.0.min.js""></script>")
     html.write ("<script>alert( $ );</script>")
End Sub

Function СЦЕПДИАП_A(Диапазон As Variant, Optional Разделитель As String = " ", _
                     Optional ПоСтолбцам As Boolean = False, Optional сПереносом As Boolean = False) As String
'---------------------------------------------------------------------------------------
' Author       : RAN
' Purpose      : Сцепляет текст ячеек из заданного диапазона
' Notes      : Разделитель по умолчанию " "
' Notes      : Optional ПоСтолбцам - просмотр по строкам(умолчание) и по столбцам
' Notes      : Optional сПереносом по умолчанию - "нет"
'---------------------------------------------------------------------------------------
     Dim i&, j&, k&, arr

     If сПереносом Then
         If Разделитель <> " " Then
             Разделитель = Разделитель & vbLf
         Else
             Разделитель = vbLf
         End If
     End If

     If TypeName(Диапазон) = "Range" Then Диапазон = Диапазон.Value
     If Not IsArray(Диапазон) Then СЦЕПДИАП_A = Диапазон: Exit Function
     ReDim arr(1 To UBound(Диапазон, 1) * UBound(Диапазон, 2))
     If ПоСтолбцам Then
         For i = 1 To UBound(Диапазон, 2)
             For j = 1 To UBound(Диапазон, 1)
                 If Len(Диапазон(j, i)) Then k = k + 1: arr(k) = Диапазон(j, i)
             Next: Next
     Else
         For j = 1 To UBound(Диапазон, 1)
             For i = 1 To UBound(Диапазон, 2)
                 If Len(Диапазон(j, i)) Then k = k + 1: arr(k) = Диапазон(j, i)
             Next: Next
     End If
     СЦЕПДИАП_A = Join(arr, Разделитель)
     СЦЕПДИАП_A = Application.Trim(СЦЕПДИАП_A)
End Function

Sub nerv()
     MsgBox io(",", 1, 2, 3)
End Sub

Function io(delimiter, ParamArray arr()) As String
     io = Join(arr, delimiter)
End Function

Next: Next

Next j, i

if typeName(arr(Ubound(arr))) = "boolean" then delimiter = arr(Ubound(arr))

Function СЦЕПДИАП_A(Диапазон As Variant, Optional Разделитель As String = " ", _
                     Optional ПоСтолбцам As Boolean = False, Optional сПереносом As Boolean = False) As String
'---------------------------------------------------------------------------------------
' Author       : RAN
' Purpose      : Сцепляет текст ячеек из заданного диапазона
' Notes      : Разделитель по умолчанию " "
' Notes      : Optional ПоСтолбцам - просмотр по строкам(умолчание) и по столбцам
' Notes      : Optional сПереносом по умолчанию - "нет"
'---------------------------------------------------------------------------------------
     Dim i&, j&, k&, arr
     If сПереносом Then
         If Разделитель <> " " Then
             Разделитель = Разделитель & vbLf
         Else
             Разделитель = vbLf
         End If
     End If
     If TypeName(Диапазон) = "Range" Then Диапазон = Диапазон.Value
     If Not IsArray(Диапазон) Then СЦЕПДИАП_A = Диапазон: Exit Function
     ReDim arr(1 To UBound(Диапазон, 1) * UBound(Диапазон, 2))
     If ПоСтолбцам Then
         For i = 1 To UBound(Диапазон, 2)
             For j = 1 To UBound(Диапазон, 1)
                 If Len(Диапазон(j, i)) Then k = k + 1: arr(k) = Диапазон(j, i)
             Next: Next
     Else
         For j = 1 To UBound(Диапазон, 1)
             For i = 1 To UBound(Диапазон, 2)
                 If Len(Диапазон(j, i)) Then k = k + 1: arr(k) = Диапазон(j, i)
             Next: Next
     End If
     ReDim Preserve arr(1 To k)
     СЦЕПДИАП_A = Join(arr, Разделитель)
     СЦЕПДИАП_A = Application.Trim(СЦЕПДИАП_A)
End Function

    If сПереносом Then
          If Разделитель <> " " Then
              Разделитель = Разделитель & vbLf
          Else
              Разделитель = vbLf
          End If
      End If

If сПереносом Then Разделитель = IIf(Разделитель = " ", "", Разделитель) & vbLf

Разделитель = IIf(Разделитель = " ", "", Разделитель) & IIf(сПереносом, vbLf, "")