Страницы: 1 2 След.
RSS
Обернуть полужирный текст в ячейке тегом strong, Нужно найти в ячейке текст, выденный полужирным шрифтом и заключить его в тег strong
 
Написал функцию по вставке тега <strong> в строку, если текст выделен полужирным.

Public Function StrongTeg(rng As Range) As String

   Dim vStr As String, vTempStr As String
   Dim j As Integer, vLen As Integer
   Dim vBoldState As Boolean
       
   vStr = ""
   vTempStr = rng.Text
   vBoldState = False
   vLen = rng.Characters.Count
   For j = 1 To vLen
       If Not rng.Characters(j, 1).Font.Bold Then 'обычный
           If Not vBoldState Then 'был обычный шрифт и остался обычный
               vStr = vStr + Mid(vTempStr, j, 1)
           Else 'был полужирный стал обычный, вставляем </strong>
               vStr = vStr + "</strong>" + Mid(vTempStr, j, 1)
               vBoldState = False
           End If
       Else 'полужирный
           If Not vBoldState Then 'был обычный стал полужирный, вставляем <strong>
               vStr = vStr + "<strong>" + Mid(vTempStr, j, 1)
               vBoldState = True
           Else 'был и остался полужирный
               vStr = vStr + Mid(vTempStr, j, 1)
           End If
       End If
   Next j
   If vBoldState Then vStr = vStr + "</strong>"
   StrongTeg = vStr
   
End Function

Очень долго считает. Если вычислять для большого количества ячеек, то вообще виснет.
Что неправильно в функции? Есть ли другой, более быстрый способ для заключения полужирного текста в тег strong?
 
Переделайте функцию в обычный макрос и обрабатывайте все оптом, в цикле. Хотя прирост в скорости будет небольшим, но не нужно будет проводить операцию многократно
Согласие есть продукт при полном непротивлении сторон
 
Пробовал и в макросе, бесполезно. Не пойму, почему так медленно обрабатывает. Обычный цикл перебора строки по символам.
 
Можно попробовать заменить функцию Mid() на переменную, а плюс на конкатенацию
Код
Public Function StrongTeg(rng As Range) As String

   Dim vStr As String, vTempStr As String, iChr
   Dim j As Integer, vLen As Integer
   Dim vBoldState As Boolean
        
   vStr = ""
   vTempStr = rng.Text
   vBoldState = False
   vLen = rng.Characters.Count
   For j = 1 To vLen
        iChr = rng.Characters(j, 1).Text
       If Not rng.Characters(j, 1).Font.Bold Then 'обычный
           If Not vBoldState Then 'был обычный шрифт и остался обычный
               vStr = vStr & iChr
           Else 'был полужирный стал обычный, вставляем </strong>
               vStr = vStr & "</strong>" & iChr
               vBoldState = False
           End If
       Else 'полужирный
           If Not vBoldState Then 'был обычный стал полужирный, вставляем <strong>
               vStr = vStr & "<strong>" & iChr
               vBoldState = True
           Else 'был и остался полужирный
               vStr = vStr & iChr
           End If
       End If
   Next j
   If vBoldState Then vStr = vStr & "</strong>"
   StrongTeg = vStr
    
End Function
Согласие есть продукт при полном непротивлении сторон
 
Цитата
hilf написал:
цикл перебора строки по символам
Потому и медленно.
Это обязательно делать в Excel?
Word для этого имеет встроенные инструменты - поиск с учетом формата, и замена с использованием регулярных выражений.
Изменено: RAN - 12.11.2017 12:32:52
 
Да в Excel. Потом идет выгрузка в xml файл
 
Нет замена + на & и mid() на переменную не помогло. Строка из 1000 символов обрабатывается несколько минут.
 
Вольному воля.  :D
3 секунды
 
Странно. У меня на тексте из 1000 символов работает моментально (как UDF). Приложите файл - пример с долгой работой макроса.
Владимир
 
Прикладываю файл с функцией. Ячейку с формулой выделил желтым.
 
Проблемы с зависанием, похоже, не из-за алгоритма, используемого в макросе (хотя он далеко не оптимален). В Вашем примере установите текстовый формат ячеек в столбце A и уберите перенос по словам в столбцах A:B. Должно стать гораздо лучше.
Владимир
 
Владимир, спасибо. Установка текстового формата вроде работает. Сейчас проверю на реальных данных. А какой алгоритм оптимальный. Как найти подстроку полужирным шрифтом, не перебирая по символам?
 
Что точно не нужно делать - писать посимвольно в результирующую строку. Почитайте на этом сайте замечательные разъяснения ZVI, относящиеся к конкатенации строк. В Вашем случае можно фиксировать (так же, как это Вы делаете сейчас) точки смены шрифта и только в этот момент формировать результат (сразу подстрокой от позиции предыдущей смены шрифта). В главном цикле должно остаться только одно обращение к объекту rng. И еще - всегда используйте переменные типа Long вместо переменных типа Integer (атавизм от старых процессоров).
Владимир
 
Владимир, к сожалению на реальных данных виснет. На примере одной ячейки видно, что быстрее стало работать, но все равно медленно. Может подскажете другой путь реализации задачи?
 
Владимир, спасибо. Буду пробовать реализовать ваши советы.
 
Посимвольное считывание и анализ свойств символов ячейки из объектной модели Excel в объектную модель VBA, как известно - медленный процесс.
Впрочем, и все другие процессы взаимодействия VBA с Excel медленные, и это проявляется тем заметнее, чем больше таких взаимодействий, как в данном случае.
Поэтому предлагаю считать в VBA XML-код ячейки с тэгами форматирования с помощью специального параметра при Value и обработать этот код в VBA. Кто не знает - у свойства .Value есть необязательный параметр [RangeValueDataType], который может принимать 3 значения:
Const xlRangeValueDefault = 10 - это то, что возвращается и без параметра;
Const xlRangeValueMSPersistXML = 12 - это XML код без тэгов форматирования;
Const xlRangeValueXMLSpreadsheet = 11 - это XML код с тэгами форматированием, т.е. то, что нам и нужно.

Вот быстрый код пользовательской функции, которая выдает значение ячейки с выделением участков жирного шрифта тэгами strong:
Код
Function BoldToStrong(Cell As Range) As String
' ZVI:2017-11-13 http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=readTID=98053
' Аргумент  - ссылка на ячейку Cell
' Результат - значение ячейки Cell с выделениями участков жирного шрифта XML-тэгами strong
' Пример VBA: Debug.Print BoldToStrong(Range("A1"))
' Пример формулы Excel: =BoldToStrong(A1)

  Dim a As Variant
  Dim s As String
  Dim i As Long, j As Long
  
  ' Использовать .Value c параметром [RangeValueDataType] для получения XML значения ячейки
  s = Cell.Item(1).Value(xlRangeValueXMLSpreadsheet)
  
  ' Выделить XML-часть ячейки
  i = InStr(s, "<Cell>") + 6
  If i = 6 Then i = InStr(s, "<Cell") + 6 ' Добавлено из-за стилей
  j = InStr(i, s, "</Cell>")
  s = Mid$(s, i, j - i)
  
  ' Заменить тэги начала и конца жирного шрифта на временные символы
  s = Replace(s, "<B>", Chr$(1))
  s = Replace(s, "</B>", Chr$(2))
  
  ' Избавиться от всех тэгов и их значений, кроме текста ячейки и временных символов
  a = Split(s, "<")
  For i = 0 To UBound(a)
    a(i) = Mid(a(i), InStr(a(i), ">") + 1)
  Next
  s = Join(a, vbNullString)
  
  ' Заменить временные символы на тэги strong
  s = Replace(s, Chr$(1), "<strong>")
  s = Replace(s, Chr$(2), "</strong>")
  
  ' Преобразовать обратно коды перевода строки, кавычек и т.п. (если это нужно)
  s = Replace(s, "&#10;", vbLf)
  s = Replace(s, "&quot" & ";", Chr$(34))
  s = Replace(s, "&lt" & ";", "<")
  s = Replace(s, "&gt" & ";", ">")
  ' ...
  
  ' Вернуть результат
  BoldToStrong = s

End Function
Изменено: ZVI - 13.11.2017 14:19:36
 
Приложил пример, там есть и вспомогательная процедура TimeTest для проверки времени обработки
P.S. Обновил архив - учтено форматирование стилями
Изменено: ZVI - 13.11.2017 14:21:00
 
Владимир, спасибо за науку!
Опять много нового узнал)
использовал Range.Value десятки тысяч раз, но не додумался заглянуть в параметры ни разу
 
Присоединюсь к Игорю. Владимир, спасибо, здорово.
 
Большое спасибо за пример. Не знал о параметрах Value.
Чем шире угол зрения, тем он тупее.
 
Доброе утро, Игорь и Андрей! Да я и сам когда-то (апрель 2015г.) случайно в VBE Object Browser-е по F2 это обнаружил и поэкспериментировал. Вот, пригодилось :)
 
Если не трогать остальное форматирование, так вообще можно "мухой" сделать для выделенного диапазона :)
Код
Public Sub test()
    Dim vData As String
    vData = Selection.Value(XlRangeValueDataType.xlRangeValueXMLSpreadsheet)
    vData = Replace(Replace(vData, "<B>", "&lt;STRONG&gt;<B>"), "</B>", "</B>&lt;/STRONG&gt;")
    Selection.Value(XlRangeValueDataType.xlRangeValueXMLSpreadsheet) = vData
End Sub
 
Спасибо, Владимир, за очередное "классическое" разъяснение. Мечта любого школьника: лег спать, а утром твое домашнее задание уже выполнили! :D  
Владимир
 
Вот это да!!!! Владимир, СПАСИБО! Немедленно кладу в свое избранное.
З.Ы. Может стОит в Копилку?
Изменено: Sanja - 13.11.2017 09:49:55
Согласие есть продукт при полном непротивлении сторон
 
Владимир, я в восхищении. Век живи, век учись. Гениальное решение. Я так и думал, что форматирование должно где-то храниться. У меня видно проблема с входными данными, похоже их откуда-то скопировали. Когда я использую вашу функцию, вылазит какой-то мусор, лишние пробелы и переводы строк. Прилагаю файл с примером.
 
Уважаемый hilf, в сообщении #22 Андрей предложил очень эффективное решение для Вашего случая (конкретное преобразование по большому числу ячеек). Можете на этой основе создать новый макрос, где первое вхождение Selection нужно заменить на исходный диапазон, а второе - на результирующий.
Владимир
 
Цитата
hilf написал: Когда я использую вашу функцию, вылазит какой-то мусор, лишние пробелы и переводы строк. Прилагаю файл с примером
Подправил код в сообщении #16 и вложение в сообщении #17, чтобы учитывать форматирование стилями.
Вариант Андрея в сообщении #22 - замечательный. Если другое форматирование не мешает, то можно использовать его, но не в формулах ячеек (UDF).
 
Уважаемый sokol92. Я согласен, что моя проблема решена. Да забыл поблагодарить Андрея. Благодарю сейчас. Очень эффективное решения, я его опробовал. Работает великолепно. У меня просто сопутствующий вопрос, что не так с моими входными данными. Я свою функцию тоже переписал до совета Владимира. Взял сгенерировал строку Lorem длиной 1500 символов. Функция отработала мгновенно, меньше секунды. Взял реальные данные, функция работала 45 секунд. Попробовал сейчас по функции Владимира. Отработала мгновенно, но вылезли какие-то лишние пробелы и переводы строки. Смотришь ячейку, вроде все нормально. Я делал очистку формата. Не помогает, вылезает мусор. Просто интересно, откуда берется мусор.
 
Цитата
hilf написал: Просто интересно, откуда берется мусор.
Ответил выше - форматирование может выполняться стилями, тогда вместо поиска "<Cell>" нужен поиск "<Cell"
 
Владимир, большое спасибо вам. Точно там оформление стилями. Проблема решена до конца. У меня это первый опыт обращения в форуме. Поражен оперативностью и знаниями экспертов. Всем кто принимал участие в обсуждении спасибо.
Страницы: 1 2 След.
Наверх