Страницы: 1
RSS
Сделать заглавными первые буквы каждой строки списка внутри ячейки, Поменять регистр первых букв в первом слове каждой строки списка, который находится внутри ячейки.
 
Всем привет!
Ребята, я искренне надеюсь, что найдется какое-то решение, вы — моя последняя надежда.
Честно скажу: лопатила весь инет, просмотрела Приемы, по поиску тоже не нашлось.

Исходные данные:
Есть файл, куда выгружены в формате эксель поля карточек отелей (каждая ячейка — блок данных).
Данные выгружаются в виде списков — то есть внутри каждой ячейки обычный список, не выпадающий.
Мне нужно (точнее моему начальнику), чтобы каждая строка списка, который находится внутри ячейки, начиналась с заглавной буквы, а сам список был маркированным.

Мб я не нашла, но все готовые решения из гугла переводят лишь первое слово первой строки списка (равно ячейки) в заглавную, остальные строки внутри ячейки остаются неизменными.
А в случае с буллитами — вообще надо все вручную ставить.

Просто у меня 20 тысяч таких строк, в каждой из которых по 6-8 списков, вручную пробовала — нереально.
Прикрепляю файл с кусочком данных, внутри есть ячейка залитая зеленым — как это должно выглядеть в итоге.
А слева — ее исходник.

Спасите и помогите, молю!
always different=)
 
Ну если офис поновее то стандартными средствами можно через формулу, если нет то макрос. Или есть альтернатива, сделать это через Word, но и там пошаманить придется. типа сперва добавить через замену к переносу строк точку, изменить в предложении первую букву стандартным средством на прописную, добавить к переносу строки  буллит, и убрать точки перед переносами строк.
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
Ну если офис поновее
типа 365, то можно так
Код
="•   "&ОБЪЕДИНИТЬ(СИМВОЛ(10)&"•   ";1;ПРОПНАЧ(ФИЛЬТР.XML("<t><s>"&ПОДСТАВИТЬ(D3;СИМВОЛ(10);"</s><s>")&"</s></t>";"//s")))
 
Код
Sub UCaseFirst()
    Dim om As Object, cl As Range, s$
    Set RExp = CreateObject("VBScript.RegExp")
    RExp.Global = True: RExp.IgnoreCase = False: RExp.MultiLine = True
    RExp.Pattern = "\n."
    For Each cl In Intersect(Selection, ActiveSheet.UsedRange).Cells
        s = cl.Value
        If InStr(s, Chr(10)) Then
            Set om = RExp.Execute(s)
            For i = 0 To om.Count - 1
                s = Replace(s, om(i), UCase(om(i)))
            Next
            Mid(s, 1, 1) = UCase(Mid(s, 1, 1))
            cl.Value = s
        End If
    Next
End Sub

Предварительно неплохо избавиться от мусора (символов U+200B)
Код
Sub qq()
    Selection.Replace ChrW(8203), ""
End Sub
 
Здравствуйте. В строке "For Each Cell In Selection" Selection, можно заменить на конкретный диапазон, хотя выделить ваш даипазон с помощью Ctrl+Shift+⬇ вроди не сложно.
Код
Sub FirstLetterToUpperCase()
    Dim str As Variant, Cell As Range, newString As String, myItem
    
    For Each Cell In Selection
    str = Split(Cell.Value, Chr(10))
        For Each myItem In str
            newString = newString & Chr(149) & UCase(Left(myItem, 1)) & Right(myItem, Len(myItem) - 1) & vbLf
        Next myItem
        newString = Left(newString, Len(newString) - 1)
        Cell.Value = newString
        newString = vbNullString
    Next Cell
    
End Sub
 
Спасибо всем огромное за отклики, буду пробовать!
Боже до чего же приятно найти в сети умных людей=)
Ребята, вы — мои герои.

P.S. если не разберусь сама как это все применять, оставляю за собой право прийти в личку с вопросами.
Вы невероятно крутые, еще раз спасибо!
Изменено: Юлия Романова - 24.10.2022 13:34:21
always different=)
 
Цитата
БМВ написал:
По вопросам из тем форума, личку не читаю.
:D
Он не один такой.
Изменено: RAN - 24.10.2022 15:24:27
 
Цитата
написал:
Цитата
БМВ написал:
По вопросам из тем форума, личку не читаю.
 
Он не один такой.
Чорт=)
always different=)
 
Все получилось, все решения будут применяться в разных документах, в зависимости от задач.
Я еще раз благодарю каждого за оперативную помощь: вы помогли не только мне, но и паре коллег.

Со всем разобралась, в личку писать не буду =)
Тему можно закрывать.
Изменено: Юлия Романова - 24.10.2022 18:17:43
always different=)
 
Цитата
Юлия Романова написал:
в личку писать не буду =)
Ура-а-а-а-а-а
Страницы: 1
Наверх