0

Возьмём, например, девять ячеек, в каждом будет по одному слову или выражению. Ячейки могут быть и пустыми! В десятой ячейке будут записываться все слова через запятую, а самое последнее слово — через союз «и». Суть в том, чтобы по условию искать последнюю и неединственную непустую ячейку, и если она соответствует условиям, перед её содержимым в ячейке вывода вместо запятой писать союз «и». Возможные примеры:

Ввод:

жир
парень
дом
автобус
город
кольцо
дети
велосипед
фонарь

Вывод: жир, парень, дом, автобус, город, кольцо, дети, велосипед и фонарь

Если мы удалим пару слов из этого списка (тире обозначает пустую ячейку):

-
парень
дом
-
город
кольцо
дети
-
-

получится: парень, дом, город, кольцо и дети

Если в вводе только одна ячейка содержит слово или выражение, то в выводе должно получиться, например: город

5
  • Если версия младше 2016, нарисуйте под это дело пользовательскую функцию - и проще, и быстрее, чем городить многоэтажное безобразие в виде формулы. А если версия 2016 или свежее, то в них есть функция ОБЪЕДИНИТЬ (TEXTJOIN).
    – Akina
    2 ноя 2020 в 19:54
  • 2007, как ни странно. И да, я к макросу и клоню 2 ноя 2020 в 19:55
  • я к макросу и клоню А у нас у всех, как назло, ХШ на профилактике...
    – Akina
    2 ноя 2020 в 19:57
  • а что такое ХШ? 2 ноя 2020 в 20:01
  • ХШ - это Хрустальный Шар.
    – Akina
    2 ноя 2020 в 20:10

2 ответа 2

1
Function my_concat(source As Range) As String
Dim tmp As String, onecell As Range
For Each onecell In source
    tmp = Trim(tmp & " " & onecell.Value)
Next
my_concat = StrReverse(Replace(Replace(StrReverse(tmp), " ", " ,"), " ,", " и ", , 1))
End Function

Спокойно съест и диапазоны-многострочники.

Да - пробелы в значениях весьма нежелательны. Я бы даже сказал - недопустимы.

5
  • Я о Trim не подумал :) Так, конечно, лучше. Можно не в цикле, а в конце: Application.Trim 2 ноя 2020 в 20:40
  • @vikttur Наверное, WorksheetFunction.Trim? Да, можно.
    – Akina
    3 ноя 2020 в 4:40
  • можно так, как я записал, То, что функция листа, редактор понимает. ...Replace(Application.Trim(StrReverse(tmp)),... 3 ноя 2020 в 8:48
  • @vikttur То, что функция листа, редактор понимает Возможно, зависит от версии. У меня на 2010 Офисе ни разу не понимает...
    – Akina
    3 ноя 2020 в 8:50
  • Так и у меня 2010. Работает. И чистить правильнее сразу (выше я неправильно записал): ...Replace(StrReverse(Application.Trim(tmp)),... 3 ноя 2020 в 9:17
0
Function fMergeWords(rRng As Range) As String
    Dim sTxt As String
    Dim i As Long, n As Long
    
    For i = 1 To rRng.Cells.Count
        If rRng(i, 1).Value <> "" Then
            sTxt = sTxt & ", " & rRng(i, 1).Value
            n = n + 1
        End If
    Next i
    
    If n > 1 Then
        n = InStrRev(sTxt, ",") - 1
        sTxt = Left$(sTxt, n) & " и " & Mid$(sTxt, n + 2)
    End If
    
    fMergeWords = Mid$(sTxt, 3)
End Function

введите сюда описание изображения

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.