Преобразование нескольких ячеек в одну
Лепарж
Дата: Вторник, 30.09.2014, 14:56 |
Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация:
0
±
Замечаний:
0% ±
Excel 2000 и ранее
Помогите, еще раз плиз. Есть таблица (вложение). Есть ли возможность формулой преобразовать в указанный вид? Заранее спасибо
Помогите, еще раз плиз. Есть таблица (вложение). Есть ли возможность формулой преобразовать в указанный вид? Заранее спасибо Лепарж
К сообщению приложен файл:
--2.xls
(13.5 Kb)
Ответить
Сообщение Помогите, еще раз плиз. Есть таблица (вложение). Есть ли возможность формулой преобразовать в указанный вид? Заранее спасибо Автор - Лепарж Дата добавления - 30.09.2014 в 14:56
Pelena
Дата: Вторник, 30.09.2014, 15:50 |
Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19392
Репутация:
4537
±
Замечаний:
±
Excel 365 & Mac Excel
Формулами только с доп. столбцом
Формулами только с доп. столбцом Pelena
К сообщению приложен файл:
-2.xls
(28.5 Kb)
"Черт возьми, Холмс! Но как??!!" Ю-money 41001765434816
Ответить
Сообщение Формулами только с доп. столбцом Автор - Pelena Дата добавления - 30.09.2014 в 15:50
ShAM
Дата: Вторник, 30.09.2014, 15:56 |
Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1347
Репутация:
249
±
Замечаний:
0% ±
Excel 2010
Ответить
AlexM
Дата: Вторник, 30.09.2014, 16:00 |
Сообщение № 4
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4517
Репутация:
1129
±
Замечаний:
0% ±
Excel 2003
Функция пользователя[vba]Код
Function Join_V(iSelect As Range, iRange As Range, Delimiter As String) As String Dim x(), i As Long, s As String x = iRange.Value For i = 1 To UBound(x) If x(i, 2) = iSelect Then s = s & Delimiter & x(i, 1) Next i Join_V = Mid(s, Len(Delimiter) + 1) End Function
[/vba]
Функция пользователя[vba]Код
Function Join_V(iSelect As Range, iRange As Range, Delimiter As String) As String Dim x(), i As Long, s As String x = iRange.Value For i = 1 To UBound(x) If x(i, 2) = iSelect Then s = s & Delimiter & x(i, 1) Next i Join_V = Mid(s, Len(Delimiter) + 1) End Function
[/vba] AlexM
Номер мобильного модема (без голосовой связи) 9269171249 МегаФон, Московский регион.
Ответить
Сообщение Функция пользователя[vba]Код
Function Join_V(iSelect As Range, iRange As Range, Delimiter As String) As String Dim x(), i As Long, s As String x = iRange.Value For i = 1 To UBound(x) If x(i, 2) = iSelect Then s = s & Delimiter & x(i, 1) Next i Join_V = Mid(s, Len(Delimiter) + 1) End Function
[/vba] Автор - AlexM Дата добавления - 30.09.2014 в 16:00
krosav4ig
Дата: Вторник, 30.09.2014, 18:47 |
Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация:
997
±
Замечаний:
0% ±
Excel 2007,2010,2013
Еще вариант UDF [vba]Код
Function JoinArr$(rng As Range, c$, rng1 As Range, Optional del$ = ", ") Dim arr arr = Evaluate("=IF(" & rng.Address & "=""" & c & """," & rng1.Address & ",)") If UBound(rng.Value) > 1 Then arr = Application.Transpose(arr) JoinArr = Replace(join(arr, del), del & 0, "") JoinArr = Right(JoinArr, Len(JoinArr) + (arr(1) = 0) * (Len(del) + 1)) Erase arr End Function
[/vba]
Еще вариант UDF [vba]Код
Function JoinArr$(rng As Range, c$, rng1 As Range, Optional del$ = ", ") Dim arr arr = Evaluate("=IF(" & rng.Address & "=""" & c & """," & rng1.Address & ",)") If UBound(rng.Value) > 1 Then arr = Application.Transpose(arr) JoinArr = Replace(join(arr, del), del & 0, "") JoinArr = Right(JoinArr, Len(JoinArr) + (arr(1) = 0) * (Len(del) + 1)) Erase arr End Function
[/vba] krosav4ig
email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
Ответить
Сообщение Еще вариант UDF [vba]Код
Function JoinArr$(rng As Range, c$, rng1 As Range, Optional del$ = ", ") Dim arr arr = Evaluate("=IF(" & rng.Address & "=""" & c & """," & rng1.Address & ",)") If UBound(rng.Value) > 1 Then arr = Application.Transpose(arr) JoinArr = Replace(join(arr, del), del & 0, "") JoinArr = Right(JoinArr, Len(JoinArr) + (arr(1) = 0) * (Len(del) + 1)) Erase arr End Function
[/vba] Автор - krosav4ig Дата добавления - 30.09.2014 в 18:47
Лепарж
Дата: Среда, 01.10.2014, 08:58 |
Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация:
0
±
Замечаний:
0% ±
Excel 2000 и ранее
Спасибо огромное
Ответить
Сообщение Спасибо огромное Автор - Лепарж Дата добавления - 01.10.2014 в 08:58