Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Функция (UDF) "СКЛЕИТЬ" - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: _Boroda_, китин  
Мир MS Excel » Вопросы и решения » Готовые решения » Функция (UDF) "СКЛЕИТЬ" (Возвращает "склеенные" тексты из ячеек диапазона)
Функция (UDF) "СКЛЕИТЬ"
Alex_ST Дата: Четверг, 26.08.2010, 11:27 | Сообщение № 1
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3198
Репутация: 606 ±
Замечаний: 0% ±

2003
=======================================================
Функция (UDF) "СКЛЕИТЬ"
=======================================================
Данная Определенная пользователем функция (User-Defined Function или UDF) возвращает в ячейку листа, куда она введена, "склеенные" в одну строку тексты из ячеек заданного диапазона с задаваемыми при необходимости разделителями данных из разных ячеек.
[vba]
Код

Function СКЛЕИТЬ(Диапазон As Range, _
                   Optional Разделитель_Данных$ = "", _
                   Optional Переносить_ДА_НЕТ$ = "ДА") As String
'---------------------------------------------------------------------------------------
' Procedure    : СКЛЕИТЬ
' Author       : Alex_ST
' Purpose      : склеить тексты из выделенных ячеек в одну строку с задаваемыми при необходимости разделителями данных из разных ячеек
' Notes        : по умолчанию включен перенос строк внутри ячейки
'---------------------------------------------------------------------------------------
     Dim Слитый_Текст$, Перенос_Строки$, Ячейка As Range
     If Переносить_ДА_НЕТ$ <> "НЕТ" Then Перенос_Строки = vbLf
     For Each Ячейка In Диапазон
        If Слитый_Текст = "" Then
           Слитый_Текст = Application.WorksheetFunction.Trim(Ячейка.Value)   ' будут удаляться лидирующие и финиширующие пробелы, а также многократные пробелы между словами (исползуется стандартная функция СЖПРОБЕЛЫ)
        Else
           Слитый_Текст = Слитый_Текст & Разделитель_Данных & Перенос_Строки & Application.WorksheetFunction.Trim(Ячейка.Value)   
        End If
     Next Ячейка
     СКЛЕИТЬ = Слитый_Текст
End Function
[/vba]

Примечания:
При "склеивании" удаляются лидирующие и финиширующие пробелы, а также многократные пробелы между словами (используется стандартная функция СЖПРОБЕЛЫ).
Если это не нужно, то можно в коде заменить [vba]
Код
Application.WorksheetFunction.Trim(Ячейка.Value)
на
Код
Ячейка.Value
[/vba]



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
Сообщение=======================================================
Функция (UDF) "СКЛЕИТЬ"
=======================================================
Данная Определенная пользователем функция (User-Defined Function или UDF) возвращает в ячейку листа, куда она введена, "склеенные" в одну строку тексты из ячеек заданного диапазона с задаваемыми при необходимости разделителями данных из разных ячеек.
[vba]
Код

Function СКЛЕИТЬ(Диапазон As Range, _
                   Optional Разделитель_Данных$ = "", _
                   Optional Переносить_ДА_НЕТ$ = "ДА") As String
'---------------------------------------------------------------------------------------
' Procedure    : СКЛЕИТЬ
' Author       : Alex_ST
' Purpose      : склеить тексты из выделенных ячеек в одну строку с задаваемыми при необходимости разделителями данных из разных ячеек
' Notes        : по умолчанию включен перенос строк внутри ячейки
'---------------------------------------------------------------------------------------
     Dim Слитый_Текст$, Перенос_Строки$, Ячейка As Range
     If Переносить_ДА_НЕТ$ <> "НЕТ" Then Перенос_Строки = vbLf
     For Each Ячейка In Диапазон
        If Слитый_Текст = "" Then
           Слитый_Текст = Application.WorksheetFunction.Trim(Ячейка.Value)   ' будут удаляться лидирующие и финиширующие пробелы, а также многократные пробелы между словами (исползуется стандартная функция СЖПРОБЕЛЫ)
        Else
           Слитый_Текст = Слитый_Текст & Разделитель_Данных & Перенос_Строки & Application.WorksheetFunction.Trim(Ячейка.Value)   
        End If
     Next Ячейка
     СКЛЕИТЬ = Слитый_Текст
End Function
[/vba]

Примечания:
При "склеивании" удаляются лидирующие и финиширующие пробелы, а также многократные пробелы между словами (используется стандартная функция СЖПРОБЕЛЫ).
Если это не нужно, то можно в коде заменить [vba]
Код
Application.WorksheetFunction.Trim(Ячейка.Value)
на
Код
Ячейка.Value
[/vba]

Автор - Alex_ST
Дата добавления - 26.08.2010 в 11:27
Формуляр Дата: Пятница, 15.06.2012, 14:22 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 832
Репутация: 255 ±
Замечаний: 0% ±

Excel 2003, 2013
Хочу предложить свой вариант аналогичной ф-ции с преобразованием размерности массива:
[vba]
Code

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
[/vba]


Excel 2003 EN, 2013 EN
 
Ответить
СообщениеХочу предложить свой вариант аналогичной ф-ции с преобразованием размерности массива:
[vba]
Code

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
[/vba]

Автор - Формуляр
Дата добавления - 15.06.2012 в 14:22
KuklP Дата: Четверг, 16.08.2012, 09:32 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
И мой:
[vba]
Code
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
[/vba]
Помедленней, чем у Формуляра, но быстрей Лешиного. И компактней, чем оба предыдущих smile
Исправил для варианта с одной строкой.
К сообщению приложен файл: 9718906.xls (25.0 Kb)


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Пятница, 17.08.2012, 08:58
 
Ответить
СообщениеИ мой:
[vba]
Code
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
[/vba]
Помедленней, чем у Формуляра, но быстрей Лешиного. И компактней, чем оба предыдущих smile
Исправил для варианта с одной строкой.

Автор - KuklP
Дата добавления - 16.08.2012 в 09:32
nerv Дата: Четверг, 16.08.2012, 13:33 | Сообщение № 4
Группа: Редакторы
Ранг: Обитатель
Сообщений: 431
Репутация: 193 ±
Замечаний: 0% ±

Quote (KuklP)
но быстрей Лешиного

так Лешин вариант лохматого года laugh


Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук


YM 41001156540584 / WM WMR R21924176233

https://github.com/nervgh/vba
 
Ответить
Сообщение
Quote (KuklP)
но быстрей Лешиного

так Лешин вариант лохматого года laugh

Автор - nerv
Дата добавления - 16.08.2012 в 13:33
Alex_ST Дата: Четверг, 16.08.2012, 13:38 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3198
Репутация: 606 ±
Замечаний: 0% ±

2003
Блин! Мыла о репликах в старых постах почему-то перестали приходить angry
Хотя раньше (когда я их создавал) точно приходили. Какой-то глюк форума.
Я сюда случайно заглянул чтобы посмотреть что новенького и увидел, что мои старые посты всплыли и в них есть реплики.
Ща будем посмотреть.



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
СообщениеБлин! Мыла о репликах в старых постах почему-то перестали приходить angry
Хотя раньше (когда я их создавал) точно приходили. Какой-то глюк форума.
Я сюда случайно заглянул чтобы посмотреть что новенького и увидел, что мои старые посты всплыли и в них есть реплики.
Ща будем посмотреть.

Автор - Alex_ST
Дата добавления - 16.08.2012 в 13:38
Alex_ST Дата: Четверг, 16.08.2012, 15:38 | Сообщение № 6
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3198
Репутация: 606 ±
Замечаний: 0% ±

2003
Посмотрел у себя. Увидел, что макрос давно уже переделан в обработку массива [vba]
Code
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
[/vba]

P.S. Долго гадал над тайным скрытым смыслом Серёгиного
Quote (KuklP)
Join(Application.Index(a, i, 0), Разделитель_Данных)
Т.к. не работает, попробовал исправить, порывшись по Справке...
Нифига не понял. Наверное, Серёга описАлся. (или моей ерундиции не хватает и Справка у меня кривая)



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Пятница, 17.08.2012, 13:00
 
Ответить
СообщениеПосмотрел у себя. Увидел, что макрос давно уже переделан в обработку массива [vba]
Code
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
[/vba]

P.S. Долго гадал над тайным скрытым смыслом Серёгиного
Quote (KuklP)
Join(Application.Index(a, i, 0), Разделитель_Данных)
Т.к. не работает, попробовал исправить, порывшись по Справке...
Нифига не понял. Наверное, Серёга описАлся. (или моей ерундиции не хватает и Справка у меня кривая)

Автор - Alex_ST
Дата добавления - 16.08.2012 в 15:38
KuklP Дата: Пятница, 17.08.2012, 09:02 | Сообщение № 7
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Не описался. Application.Index(a, i, 0) берет строку i из массива a. См. исправленный вариант в том сообщении. С примером. А в твоем варианте одной строки хватит:
[vba]
Code
СКЛЕИТЬ = join(Arr,Разделитель)
[/vba]
smile


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Пятница, 17.08.2012, 09:13
 
Ответить
СообщениеНе описался. Application.Index(a, i, 0) берет строку i из массива a. См. исправленный вариант в том сообщении. С примером. А в твоем варианте одной строки хватит:
[vba]
Code
СКЛЕИТЬ = join(Arr,Разделитель)
[/vba]
smile

Автор - KuklP
Дата добавления - 17.08.2012 в 09:02
Alex_ST Дата: Пятница, 17.08.2012, 14:27 | Сообщение № 8
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3198
Репутация: 606 ±
Замечаний: 0% ±

2003
Серёга,
я, естественно, первым же делом попробовал применить Join, но массив Arr = Application.Trim(ДИАПАЗОН.Value) может получиться и двумерным в зависимости от размерности ДИАПАЗОНА, а с ним Join не работает.
Поэтому чтобы не запариваться с размерностями массива я переделал так:[vba]
Code
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
[/vba]

А по поводу Application.Index(a, i, 0) - не знаю. У меня почему-то работать не хочет даже если я ставлю не Application.Index, а Application.WorksheetFunction.Index
Да и это моё крайнее решение, ИМХО, достаточно простое и должно быть не тормозным



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
СообщениеСерёга,
я, естественно, первым же делом попробовал применить Join, но массив Arr = Application.Trim(ДИАПАЗОН.Value) может получиться и двумерным в зависимости от размерности ДИАПАЗОНА, а с ним Join не работает.
Поэтому чтобы не запариваться с размерностями массива я переделал так:[vba]
Code
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
[/vba]

А по поводу Application.Index(a, i, 0) - не знаю. У меня почему-то работать не хочет даже если я ставлю не Application.Index, а Application.WorksheetFunction.Index
Да и это моё крайнее решение, ИМХО, достаточно простое и должно быть не тормозным

Автор - Alex_ST
Дата добавления - 17.08.2012 в 14:27
KuklP Дата: Пятница, 17.08.2012, 15:17 | Сообщение № 9
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Леш, а ты мой пример смотрел от Вчера, 09:32? А по поводу многомерности, у меня в примере тоже есть. Только клеится не поячеечно, а построчно.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Пятница, 17.08.2012, 15:24
 
Ответить
СообщениеЛеш, а ты мой пример смотрел от Вчера, 09:32? А по поводу многомерности, у меня в примере тоже есть. Только клеится не поячеечно, а построчно.

Автор - KuklP
Дата добавления - 17.08.2012 в 15:17
Alex_ST Дата: Пятница, 17.08.2012, 16:08 | Сообщение № 10
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3198
Репутация: 606 ±
Замечаний: 0% ±

2003
Посмотрел. Почему-то заработало. Хотя раньше ругалось на Application.Index
Не пойму, в чём было дело.
Правда, я тут подвисал и пришлось перегружаться, а потом отвлекли. Вот сразу и не отписался.

Но всё равно, мой код тоже не плох (ИМХО, конечно biggrin )



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Пятница, 17.08.2012, 20:17
 
Ответить
СообщениеПосмотрел. Почему-то заработало. Хотя раньше ругалось на Application.Index
Не пойму, в чём было дело.
Правда, я тут подвисал и пришлось перегружаться, а потом отвлекли. Вот сразу и не отписался.

Но всё равно, мой код тоже не плох (ИМХО, конечно biggrin )

Автор - Alex_ST
Дата добавления - 17.08.2012 в 16:08
nerv Дата: Пятница, 17.08.2012, 20:56 | Сообщение № 11
Группа: Редакторы
Ранг: Обитатель
Сообщений: 431
Репутация: 193 ±
Замечаний: 0% ±

Quote (Alex_ST)
Это в ячейку листа можно ввести до 255 символов

#2

На правах офф-топа:
сейчас извращаюсь, создаю com(?)/vb объект - html-страницу, а в этой странице уже на javascript'е пишу smile
Чуть позже будет код )))

Более того, подключаю либы js biggrin

Для примера:
[vba]
Code
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
[/vba]


Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук


YM 41001156540584 / WM WMR R21924176233

https://github.com/nervgh/vba


Сообщение отредактировал nerv - Пятница, 17.08.2012, 20:59
 
Ответить
Сообщение
Quote (Alex_ST)
Это в ячейку листа можно ввести до 255 символов

#2

На правах офф-топа:
сейчас извращаюсь, создаю com(?)/vb объект - html-страницу, а в этой странице уже на javascript'е пишу smile
Чуть позже будет код )))

Более того, подключаю либы js biggrin

Для примера:
[vba]
Code
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
[/vba]

Автор - nerv
Дата добавления - 17.08.2012 в 20:56
RAN Дата: Пятница, 17.08.2012, 23:23 | Сообщение № 12
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Не знаю, на сколько важна скорострельность, а этот сцепляет и по столбцам, и из закрытой книги.
[vba]
Code
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
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеНе знаю, на сколько важна скорострельность, а этот сцепляет и по столбцам, и из закрытой книги.
[vba]
Code
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
[/vba]

Автор - RAN
Дата добавления - 17.08.2012 в 23:23
Alex_ST Дата: Суббота, 18.08.2012, 20:58 | Сообщение № 13
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3198
Репутация: 606 ±
Замечаний: 0% ±

2003
Quote (RAN)
[vba]
Code
ReDim arr(1 To UBound(Диапазон, 1) * UBound(Диапазон, 2)
[/vba]

Интересный подход абсолютно с другой стороны: сначала сделать массив-строку, а потом уже её сцеплять Join'ом. Надо будет попробовать подпилить-подсократить код на досуге.
По поводу вытягивания из закрытых книг - не уверен, что это шибко нужно. Но если не даёт усложнения кода, то пусть будет biggrin

Про скорострельность, Андрей, ты по-моему абсолютно прав. Это UDF для применения в качестве формулы листа. И объединять она должна не тысячи ячеек, а от силы десяток-два.

А вот научить UDF-ку обрабатывать (склеивать) тексты ячеек из разбросанных по листу (-ам) ячеек было бы очень здорово.
Тогда бы получилась усовершенствованная функция СЦЕПИТЬ.
Но к сожалению тогда ей параметры надо задавать как ParamArray, а при таком типе аргументов нет возможности задать ещё и параметры "переносить" и "разделитель" sad



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Воскресенье, 19.08.2012, 12:35
 
Ответить
Сообщение
Quote (RAN)
[vba]
Code
ReDim arr(1 To UBound(Диапазон, 1) * UBound(Диапазон, 2)
[/vba]

Интересный подход абсолютно с другой стороны: сначала сделать массив-строку, а потом уже её сцеплять Join'ом. Надо будет попробовать подпилить-подсократить код на досуге.
По поводу вытягивания из закрытых книг - не уверен, что это шибко нужно. Но если не даёт усложнения кода, то пусть будет biggrin

Про скорострельность, Андрей, ты по-моему абсолютно прав. Это UDF для применения в качестве формулы листа. И объединять она должна не тысячи ячеек, а от силы десяток-два.

А вот научить UDF-ку обрабатывать (склеивать) тексты ячеек из разбросанных по листу (-ам) ячеек было бы очень здорово.
Тогда бы получилась усовершенствованная функция СЦЕПИТЬ.
Но к сожалению тогда ей параметры надо задавать как ParamArray, а при таком типе аргументов нет возможности задать ещё и параметры "переносить" и "разделитель" sad

Автор - Alex_ST
Дата добавления - 18.08.2012 в 20:58
nerv Дата: Воскресенье, 19.08.2012, 00:18 | Сообщение № 14
Группа: Редакторы
Ранг: Обитатель
Сообщений: 431
Репутация: 193 ±
Замечаний: 0% ±

Quote (Alex_ST)
при таком типе аргументов нет возможности задать ещё и параметры "переносить" и "разделитель"

все возможно )


Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук


YM 41001156540584 / WM WMR R21924176233

https://github.com/nervgh/vba
 
Ответить
Сообщение
Quote (Alex_ST)
при таком типе аргументов нет возможности задать ещё и параметры "переносить" и "разделитель"

все возможно )

Автор - nerv
Дата добавления - 19.08.2012 в 00:18
Alex_ST Дата: Воскресенье, 19.08.2012, 09:56 | Сообщение № 15
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3198
Репутация: 606 ±
Замечаний: 0% ±

2003
Quote (nerv)
все возможно )

Ну-ка, ну-ка!
А слабо сделать примерчик, в котором процедура может ОДНОВРЕМЕННО (ведь для функции листа именно так и делается) получать параметры и как ParamArray, и как обычные?
Во всех учебниках по VBA написано, что если аргументы задаются как ParamArray, то других аргументов задать нельзя.

Конечно, можно извратиться и договориться, что первые 2-3 элемента массива - параметры склеивания, а остальные - склеиваемые элементы.
Но это будет не удобно в использовании, т.к. все элементы UDF при её вводе юзером будут называться одинаково и нужно будет просто тупо помнить в какой последовательности их надо вводить.



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
Сообщение
Quote (nerv)
все возможно )

Ну-ка, ну-ка!
А слабо сделать примерчик, в котором процедура может ОДНОВРЕМЕННО (ведь для функции листа именно так и делается) получать параметры и как ParamArray, и как обычные?
Во всех учебниках по VBA написано, что если аргументы задаются как ParamArray, то других аргументов задать нельзя.

Конечно, можно извратиться и договориться, что первые 2-3 элемента массива - параметры склеивания, а остальные - склеиваемые элементы.
Но это будет не удобно в использовании, т.к. все элементы UDF при её вводе юзером будут называться одинаково и нужно будет просто тупо помнить в какой последовательности их надо вводить.

Автор - Alex_ST
Дата добавления - 19.08.2012 в 09:56
nerv Дата: Среда, 22.08.2012, 10:23 | Сообщение № 16
Группа: Редакторы
Ранг: Обитатель
Сообщений: 431
Репутация: 193 ±
Замечаний: 0% ±

Quote (Alex_ST)
А слабо сделать примерчик, в котором процедура может ОДНОВРЕМЕННО (ведь для функции листа именно так и делается) получать параметры и как ParamArray, и как обычные?
Во всех учебниках по VBA написано, что если аргументы задаются как ParamArray, то других аргументов задать нельзя.

Вообще-то, брать "на слабо" не хорошо. Но, раз ты просишь пример:
[vba]
Code
Sub nerv()
     MsgBox io(",", 1, 2, 3)
End Sub

Function io(delimiter, ParamArray arr()) As String
     io = Join(arr, delimiter)
End Function
[/vba]

RAN, ну вот зачем это извращение?
[vba]
Code
Next: Next
[/vba]
если так хочется записать в одну строчку, тогда уж
[vba]
Code
Next j, i
[/vba]


Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук


YM 41001156540584 / WM WMR R21924176233

https://github.com/nervgh/vba


Сообщение отредактировал nerv - Среда, 22.08.2012, 11:30
 
Ответить
Сообщение
Quote (Alex_ST)
А слабо сделать примерчик, в котором процедура может ОДНОВРЕМЕННО (ведь для функции листа именно так и делается) получать параметры и как ParamArray, и как обычные?
Во всех учебниках по VBA написано, что если аргументы задаются как ParamArray, то других аргументов задать нельзя.

Вообще-то, брать "на слабо" не хорошо. Но, раз ты просишь пример:
[vba]
Code
Sub nerv()
     MsgBox io(",", 1, 2, 3)
End Sub

Function io(delimiter, ParamArray arr()) As String
     io = Join(arr, delimiter)
End Function
[/vba]

RAN, ну вот зачем это извращение?
[vba]
Code
Next: Next
[/vba]
если так хочется записать в одну строчку, тогда уж
[vba]
Code
Next j, i
[/vba]

Автор - nerv
Дата добавления - 22.08.2012 в 10:23
Формуляр Дата: Среда, 22.08.2012, 10:42 | Сообщение № 17
Группа: Друзья
Ранг: Ветеран
Сообщений: 832
Репутация: 255 ±
Замечаний: 0% ±

Excel 2003, 2013
Quote (nerv)
Function io(delimiter, ParamArray arr()) As String

Ну-у, так - не интересно. delimiter должен быть optional.

Лучше уж ориентироваться по типу:
[vba]
Code
if typeName(arr(Ubound(arr))) = "boolean" then delimiter = arr(Ubound(arr))
[/vba]


Excel 2003 EN, 2013 EN

Сообщение отредактировал Формуляр - Среда, 22.08.2012, 10:50
 
Ответить
Сообщение
Quote (nerv)
Function io(delimiter, ParamArray arr()) As String

Ну-у, так - не интересно. delimiter должен быть optional.

Лучше уж ориентироваться по типу:
[vba]
Code
if typeName(arr(Ubound(arr))) = "boolean" then delimiter = arr(Ubound(arr))
[/vba]

Автор - Формуляр
Дата добавления - 22.08.2012 в 10:42
RAN Дата: Пятница, 31.08.2012, 13:31 | Сообщение № 18
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Все пробовал либо со всеми заполненными ячейками, либо с разделителем пробел. А лишние пробелы и Trim хорошо убирал. Сейчас попробовал сразделителем ";" - лишние появляются. Пришлось подкорректировать
[vba]
Code
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
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеВсе пробовал либо со всеми заполненными ячейками, либо с разделителем пробел. А лишние пробелы и Trim хорошо убирал. Сейчас попробовал сразделителем ";" - лишние появляются. Пришлось подкорректировать
[vba]
Code
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
[/vba]

Автор - RAN
Дата добавления - 31.08.2012 в 13:31
Alex_ST Дата: Пятница, 31.08.2012, 14:21 | Сообщение № 19
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3198
Репутация: 606 ±
Замечаний: 0% ±

2003
Привет, Андрей!
А может быть для красоты заменить[vba]
Code
    If сПереносом Then
          If Разделитель <> " " Then
              Разделитель = Разделитель & vbLf
          Else
              Разделитель = vbLf
          End If
      End If
[/vba]
на [vba]
Code
If сПереносом Then Разделитель = IIf(Разделитель = " ", "", Разделитель) & vbLf
[/vba] - это точно пройдёт
Или вообще на [vba]
Code
Разделитель = IIf(Разделитель = " ", "", Разделитель) & IIf(сПереносом, vbLf, "")
[/vba]- тут надо "пощупать в разных позах" возможные сочетания, но мне сейчас к сожалению некогда - на работе "срочняк" smile



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Пятница, 31.08.2012, 14:22
 
Ответить
СообщениеПривет, Андрей!
А может быть для красоты заменить[vba]
Code
    If сПереносом Then
          If Разделитель <> " " Then
              Разделитель = Разделитель & vbLf
          Else
              Разделитель = vbLf
          End If
      End If
[/vba]
на [vba]
Code
If сПереносом Then Разделитель = IIf(Разделитель = " ", "", Разделитель) & vbLf
[/vba] - это точно пройдёт
Или вообще на [vba]
Code
Разделитель = IIf(Разделитель = " ", "", Разделитель) & IIf(сПереносом, vbLf, "")
[/vba]- тут надо "пощупать в разных позах" возможные сочетания, но мне сейчас к сожалению некогда - на работе "срочняк" smile

Автор - Alex_ST
Дата добавления - 31.08.2012 в 14:21
Fitcher Дата: Среда, 25.12.2013, 12:50 | Сообщение № 20
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
Вот это работает, но в столбцах стоит фильтр, как сделать, чтобы скрытые строки он не переносил? и разделял текст не пробелом а "шт" ?
 
Ответить
СообщениеВот это работает, но в столбцах стоит фильтр, как сделать, чтобы скрытые строки он не переносил? и разделял текст не пробелом а "шт" ?

Автор - Fitcher
Дата добавления - 25.12.2013 в 12:50
Мир MS Excel » Вопросы и решения » Готовые решения » Функция (UDF) "СКЛЕИТЬ" (Возвращает "склеенные" тексты из ячеек диапазона)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!