ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Функция СЦЕПИТЬ для диапазона данных.
5 сообщений из 5, страница 1 из 1
Функция СЦЕПИТЬ для диапазона данных.
    #34755004
Meetrich
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Meetrich
Гость
Здравствуйте.

У меня возникла острая необходимость создать пользовательскую функцию СЦЕПИТЬ для диапазона данных. (не =СЦЕПИТЬ(A1;A2;A3;A4), а просто =СЦЕПИТЬДП(A1:A4) (СЦЕПИТЬДП-я ее так назвал). И вот что у меня получилось.

Function СЦЕПИТЬДП(rng As Range) As Variant
total = ""
Dim cell As Range
For Each cell In rng
total = total & cell
Next cell
СЦЕПИТЬДП = total
End Function

Она прекрасно работает, так что кому этого достаточно могут её использовать.

Мне же необходимо, чтобы она могла работать и с массивами. Как это, скажем, делает функция СУММ

Пример:

1 20
2 10
3 15
4 10
5 20

{=СУММ((B2:B6=10)*A2:A6)} дает ответ 6, а моя функция должна давать ответ 24.
Если кто-нибудь знает как это сделать, пожалуйста подскажите. Премного благодарен.
...
Рейтинг: 0 / 0
27.08.2007, 14:53:01
| Ответить | Цитировать | Написать  
Функция СЦЕПИТЬ для диапазона данных.
    #34755959
Фотография udgeen69
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
udgeen69
Участник
Function СЦУММ(rng As Range, priznak As String) As Variant

Dim total As Variant
total = ""
Dim cell As Range
For Each cell In rng
If cell.Value = priznak Then
total = total & cell.Offset(0, -1).Value
End If
Next cell
СЦУММ = total
End Function
...
Рейтинг: 0 / 0
27.08.2007, 17:53:30
| Ответить | Цитировать | Написать  
Функция СЦЕПИТЬ для диапазона данных.
    #34756092
Meetrich
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Meetrich
Гость
Большое спасибо, очень помогли. Ввел переменную offset и получил универсальную и такую необходимую функцию.

Ещё раз Большое спасибо!
...
Рейтинг: 0 / 0
27.08.2007, 18:37:33
| Ответить | Цитировать | Написать  
Функция СЦЕПИТЬ для диапазона данных.
    #34756246
KL (XL)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
KL (XL)
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
Function СЦЕПИТЬ_МАССИВ(DataArray As Variant, Delimiter As String)
    Dim arrTemp, arrTemp2, row As Long, col As Long, i As Long
    arrTemp = DataArray
    If Not IsArray(arrTemp) Then GoTo xIt
    On Error Resume Next
    col = UBound(arrTemp,  2 )
    On Error GoTo  0 
    Select Case col
    Case  1 : arrTemp = Application.Transpose(arrTemp)
    Case Is >  1 
        ReDim arrTemp2(UBound(arrTemp,  1 ) * UBound(arrTemp,  2 ) -  1 )
        For row =  1  To UBound(arrTemp,  1 )
            For col =  1  To UBound(arrTemp,  2 )
                arrTemp2(i) = arrTemp(row, col)
                i = i +  1 
            Next col
        Next row
        arrTemp = arrTemp2
    End Select
    On Error GoTo xIt
    СЦЕПИТЬ_МАССИВ = Join(arrTemp, Delimiter)
    Exit Function
xIt:
    СЦЕПИТЬ_МАССИВ = CVErr(xlErrValue)
End Function

для простых операций с диапазонами и константами массива, ввод обычный - ENTER

=СЦЕПИТЬ_МАССИВ(A1:A3;"")
=СЦЕПИТЬ_МАССИВ(A1:C1;"")
=СЦЕПИТЬ_МАССИВ(A1:C3;"")
=СЦЕПИТЬ_МАССИВ({"a";2;"c"};"")
=СЦЕПИТЬ_МАССИВ({"a":"d":"g"};"")
=СЦЕПИТЬ_МАССИВ({"a";2;"c":"d";3;"f":"g";4;"i"};"")

и т.д.

для сложных операций с диапазонами, ввод матричный - CTRL+SHIFT+ENTER

=СЦЕПИТЬ_МАССИВ(A1:A3+5;"")
=СЦЕПИТЬ_МАССИВ(A1:C1+5;"")
=СЦЕПИТЬ_МАССИВ(A1:C3+5;"")
=СЦЕПИТЬ_МАССИВ(A1:A3*A1:A3;"")
=СЦЕПИТЬ_МАССИВ(A1:C1*A1:C1;"")
=СЦЕПИТЬ_МАССИВ(A1:C3*A1:C3;"")
=СЦЕПИТЬ_МАССИВ(A1:A3&"x";"")
=СЦЕПИТЬ_МАССИВ(A1:C1&"x";"")
=СЦЕПИТЬ_МАССИВ(A1:C3&"x";"")

и т.д.

KL
[MVP - Microsoft Excel]
...
Рейтинг: 0 / 0
27.08.2007, 19:40:24
| Ответить | Цитировать | Написать  
Функция СЦЕПИТЬ для диапазона данных.
    #34756274
KL (XL)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
KL (XL)
Участник
Поправка к коду функции:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
Function СЦЕПИТЬ_МАССИВ (DataArray As Variant, Delimiter As String)
    Dim arrTemp, arrTemp2, row As Long, col As Long, i As Long
    arrTemp = DataArray
    If Not IsArray(arrTemp) Then GoTo xIt
    On Error Resume Next
    row = UBound(arrTemp,  1 )
    col = UBound(arrTemp,  2 )
    On Error GoTo  0 
    Select Case True
    Case col =  1 : arrTemp = Application.Transpose(arrTemp)
    Case col >  1  And row =  1 : arrTemp = Application.Transpose(Application.Transpose(arrTemp))
    Case col >  1  And row >  1 
        ReDim arrTemp2(UBound(arrTemp,  1 ) * UBound(arrTemp,  2 ) -  1 )
        For row =  1  To UBound(arrTemp,  1 )
            For col =  1  To UBound(arrTemp,  2 )
                arrTemp2(i) = arrTemp(row, col)
                i = i +  1 
            Next col
        Next row
        arrTemp = arrTemp2
    End Select
    On Error GoTo xIt
    СЦЕПИТЬ_МАССИВ = Join(arrTemp, Delimiter)
    Exit Function
xIt:
    СЦЕПИТЬ_МАССИВ = CVErr(xlErrValue)
End Function

KL
[MVP - Microsoft Excel]
...
Рейтинг: 0 / 0
27.08.2007, 19:58:07
| Ответить | Цитировать | Написать  
5 сообщений из 5, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Функция СЦЕПИТЬ для диапазона данных.
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&gotonew=1&tid=2182398]:
 0ms
get settings:
 9ms
get forum list:
 19ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 65ms
get topic data:
 11ms
get first new msg:
 6ms
get forum data:
 3ms
get page messages:
 53ms
get tp. blocked users:
 1ms
others: 238ms
total:  411ms
созд. / загр.: 411ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]