Страницы: 1
RSS
При замене символа в ячейке "слетает" оформление, При замене символов в ячейке все оформление по шрифтам сбрасывается
 
Добрый день всем.
Суть задачи: выгружается список категорий и подкатегорий в одну ячейку. Нужно Категории выделить жирным шрифтом, подкатегории обычным. Пример:

Категория 1
подкатегория 1
подкатегория 2
подкатегория 3

Категория 2
подкатегория 1
подкатегория 2
подкатегория 3

Сами данный выгружаются в таком же виде, только без выделения. Были добавлены символы табуляции вокруг Категорий для облегчения написания макроса. Макрос срабатывает каждый раз, когда мы переключаемся на страницу, когда активизируем.

Текст макроса:
Код
Public Sub boldFontTargets()
    Dim actSheet As Worksheet
    Dim startPos, endPos, countSymbol As Integer
    Dim flag, flagBold As Boolean
    Dim searchStr, newValue As String
        
    Set actSheet = ThisWorkbook.ActiveSheet
    flag = True
    endPos = 0
    startPos = 0
    flagBold = True
    searchStr = vbTab
    
    While flag
        If (startPos = 0) Then
            startPos = InStr(1, actSheet.Cells(5, 3), searchStr)
        End If
        endPos = InStr(startPos + 1, actSheet.Cells(5, 3), searchStr)
        
        If (endPos = 0) Then
            countSymbol = Len(actSheet.Cells(5, 3)) - startPos
        Else
            countSymbol = endPos - startPos
        End If
        
        If (IsNumeric(startPos) And IsNumeric(endPos) And startPos > 0 And endPos > 0) Then
            With actSheet.Cells(5, 3).Characters(startPos, countSymbol).Font
                .Bold = flagBold
            End With
            startPos = endPos
            flagBold = Not flagBold
        Else
            flag = False
        End If
    Wend
  
End Sub

Хотя табуляторы и не видно, но когда переключаешься на ячейку, то директору не понравилось.
Так вот, когда я в макросе пишу заменить табуляторы на пустышку, то весь текст в ячейке становится просто жирным.
Пытался записать ручным макросом - тоже самое. Такое чувство, что при замене все оформление сбивается.
Подскажите и дайте совет.

Заранее благодарен
 
1. откажитесь от табуляторов, усложните написание макроса
или
2. замените директора на такого, которого не раздражают табуляторы в тексте
или
3. вместо табуляторов поставьте неразрывные пробелы, переделайте чуть макрос и не говорите о пробелах директору
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
написал:
1. откажитесь от табуляторов, усложните написание макроса
или
2. замените директора на такого, которого не раздражают табуляторы в тексте
или
3. вместо табуляторов поставьте неразрывные пробелы, переделайте чуть макрос и не говорите о пробелах директору
Использование табуляторов оправдано тем, что пока не щелкнешь на ячейку, то все выглядит корректно. Только при щелчке на ячейку ты видишь эти отступы. Неразрывный пробел с нулевой шириной поставить могу, но Excel не видит его (у него нет такого кода в таблице). А Неразрывный пробел визуально все равно показывает их. Но за наводку спасибо.
Изменено: _andrew_ - 30.11.2022 09:13:19
 
у неразрывного пробела такая же ширина как и у обычного, код этого символа 160 и Excel, в отличие от пользователя,  замечательно его видит)
как латинская а "эй" и кириллическая а "а" ничем не отличаются на вид, так и неразрывный и обычный пробел на вид не отличимы,  только это знаки с разными кодами
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
написал:
у неразрывного пробела такая же ширина как и у обычного, код этого символа 160 и Excel, в отличие от пользователя,  замечательно его видит)
как латинская а "эй" и кириллическая а "а" ничем не отличаются на вид, так и неразрывный и обычный пробел на вид не отличимы,  только это знаки с разными кодами
Я возможно не так выразился. Неразрывный пробел - это все таки пробел и он виден. А есть нерарывный пробел с нулевой шириной (https://ru.wikipedia.org/wiki/%D0%9D%D0%B5%D1%80%D0%B0%D0%B7%D1%80%D1%8B%D0%B2%D0­%BD%D1%8B%D0%B9_%D0...)
Он никак не выдает себя и найти его уже Excel не может, так как его код 8288.
Откуда я выгружаю эти данные я могу такой символ в юникоде поставить, но Excel его не знает, либо за ним закреплено какоем-то другое название, которое я не знаю.
 
А так?
Код
searchStr = ChrW(8288)
Скажи мне, кудесник, любимец ба’гов...
 
возможно нужно просто сменить задачу?
не чем заменить табуляторы, а как в тексте идентифицировать названия групп (и таким образом полностью отказаться от ручной доработки текста)
макрос найдет названия групп и выделит. вы их как-то мозгами отличаете от всего остального, значит и макрос можно научить отличать и выделить - тут вообще техническая работа, не требующая никаких умственных усилий)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Данные приходят в том первоначальном виде как есть. В ячейке есть вот такая информация:

Категория 1
подкатегория 1
подкатегория 2
подкатегория 3

Категория 2
подкатегория 1
подкатегория 2
подкатегория 3

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

_Boroda_,  попробую Ваш вариант и отпишусь позже.

Просто для меня было удивлением, что при замене значения весь текст окрашивается. Видимо специфика Excel.
Спасибо всем откликнувшимся за помощь.
Изменено: _andrew_ - 30.11.2022 13:56:15
 
Цитата
_andrew_ написал:
Данные приходят в том первоначальном виде как есть.
Лучше всего привести фрагмент файла с реальными данными.
Владимир
 
см. вложение
Код
Sub BoldKat()
  Dim rg As Range, re, ms, m, i&
  Set re = CreateObject("VBScript.RegExp"):  Set rg = [a1]
  re.Global = True: re.MultiLine = True: re.Pattern = "(^|\n)\n[^\n]+\n"
  Do While Not IsEmpty(rg)
    If re.test(rg.Value) Then
      Set ms = re.Execute(rg.Value)
      For Each m In ms
        i = IIf(InStr(m, vbLf & vbLf), 1, 0)
        rg.Characters(m.firstindex + 1 + i, m.Length - 2 - i).Font.Bold = True
      Next
    End If
    Set rg = rg.Offset(1)
  Loop
End Sub
Изменено: Ігор Гончаренко - 30.11.2022 17:33:21
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Страницы: 1
Наверх