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

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

Ваш ответ

Нажимая на кнопку «Отправить ответ», вы соглашаетесь с нашими пользовательским соглашением, политикой конфиденциальности и политикой о куки

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