Как перенести значения нескольких полей в одно поле?

[katFOX]

Помогите, пожалуйста. Нужно перенести значения полей в одно поле. Пример (было-стало) во вложении.
Как это сделать?

[AlexM12]

Так вы уже перенесли.
Может быть вам формула нужна или функция для этих действий?

[katFOX]

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

[Aleksandr H.]

варианты.

Function MyConcat(startCel As Range) As Variant
    Dim rng As Range
    Dim ar() As Variant
    Dim output As Variant
    Dim tmp As Variant
    On Error GoTo er
    Set rng = Range(startCel.Offset(0, 1), startCel.Offset(0, 1).End(xlDown))
    
    ar = rng.Value
    If UBound(ar) > 20 Then ReDim Preserve ar(20)
    For Each tmp In ar
        output = output & tmp & ", "
    Next
' czy są możliwo to zrobic przez JOIN? nie wiem dlaczego nie chodzi to teraz.
    
    MyConcat = Left(output, Len(output) - 2)
    Exit Function
er:
    MyConcat = ""
End Function

Function MyConcat2(startCel As Range) As Variant
    Dim output As Variant
    Dim r As Long
    On Error GoTo er
    r = 0
    output = ""
    Do While startCel.Offset(r, 1) <> ""
        output = output & startCel.Offset(r, 1) & ", "
        r = r + 1
    Loop
    If output = "" Then GoTo er
    MyConcat2 = Left(output, Len(output) - 2)
    Exit Function
er:
    MyConcat2 = ""
End Function

вызывать

=MyConcat(B1)

=MyConcat2(B1)

=MyConcat(B7)

=MyConcat2(B7)

upd

Function MyConcat3(startCel As Range)
    On Error GoTo er
    MyConcat3 = Join(WorksheetFunction.Transpose( _
                Range(startCel.Offset(0, 1), _
                startCel.Offset(0, 1).End(xlDown)).Value), ", ")
    Exit Function
er:
    MyConcat3 = ""
    
End Function

как обработать вызов

=MyConcat(H2)

или 3, чтобы не получить в результате

текст1,текст2,текст3, , , , , текст4,текст5

?

[AlexM12]

Почти то же самое.

Function Join_V(iCells As Range) As String
    Dim Arr
    If iCells.Offset(0, 1) = Empty Then Join_V = "": Exit Function
    Arr = Range(iCells.Offset(0, 1), iCells.Offset(0, 1).End(xlDown))
    Join_V = Join(Application.Transpose(Arr), ",")
End Function

[Hugo121]

Если быть дотошным - то перенос можно сделать или вручную, или макросом, но никак не формулой - формулы этого не могут, они только отображают результат обработки данных, никак их не изменяя!
Если кто не понял - почитайте значение слова "перенос" в ВИКИ, вроде пока оно официально не изменено

[AlexM12]

Игорь, ты прав, но не любители макросов после "переноса" могут копировать в ставить специальной вставкой "значения", чем добьются настоящего переноса данных.

[katFOX]

Спасибо большое! А подскажите, пожалуйста, как это теперь применить на нашем фале?
Впервые с этим сталкиваюсь(

[Hugo121]

Сообщение от AlexM12

не любители макросов после "переноса" могут копировать в ставить специальной вставкой

Ну да, сперва спецпрокопипастить результат, потом выискать глазами источник и его удалить, частями в данном случае, или убить на это немеряно времени если например "переносили" используя ВПР().

Ответ на вопрос "как применить" - погуглите "использование UDF в Экселе".

[AlexM12]

Сообщение от Hugo121

сперва спецпрокопипастить результат, потом выискать глазами источник и его удалить, частями в данном случае, или убить на это немеряно времени

Выделить диапазон значений, полученных формулой - копировать - не снимая выделение нажать правую кнопку мыши - специальная вставка - значения - Ок.
Немерено - это не более 2 сек.