Html тэги в excel

Функция СИМВОЛ в excel используется для вставки в ячейку или формула символа, ввести который с клавиатуры не представляется возможным или это может привести к ошибке.

Содержание:

  • Пример соединения Excel + HTML
  • Приведу часть кода HTML
  • Код формул в ячейках Excel
  • Решение проблемы с помощью СИМВОЛ(34) в Excel
  • Финальный текст Excel=HTML+СИМВОЛ(34)
  • В этом видео показано как использовать функция СИМВОЛ(34) в Excel или как верстать HTML в Excel:

Ранее я использовал Excel в качестве PhotoShop, на этот раз решил проверить, а на что еще он способен.

Для быстрого создания однотипных страниц на своем сайте мне понадобилось на листе Excel сделать макет html верстки, с тегами, стилями, а значения между тегами тянулись с отдельного листа. На этом листе ячейки соответствовали необходимым мне полям для итогового макета, образцы текста были заготовлены заранее и вставлялись поочередно в первый лист, на втором листе формулы разносили данные в нужное место.

Приведу часть кода HTML

<html>
  <head>
    <title>Заголовок страницы</title>
    </head>
  <body>
    <h2>Моя страница № раз!</h2>
<p>Тут какой то длиииииииный текст для примера</p>
    </body>
</html>

Код формул в ячейках Excel

="<html>"
="<head>"
="<title>"&Лист1!B1&"</title>"
="</head>"
="<body>"
="<h2>"&Лист1!B2&"</h2>"
="<p>"&Лист1!B3&"</p>"
="</body>"
="</html>"

Как видно из кода, значения тегов title, h2, p у меня по ссылке получают с Листа3, являясь переменными. Всего-то забот, меняй значения на Лист1, а с Лист2 копируй все ячейки, вставляй в текстовый файл, сохраняй в html — и готова веб страница. Но при использовании тега h2 со встроенным стилем style=»text-align: center;» и span style=»color: #ff0000;» возникала ошибка в формуле, так как количество двойных кавычек «рвало» формулу на несовместимые друг с другом части.

<h2 style="text-align: center;">
<span style="color: #ff0000;">Моя страница № -цать!</span></h2>

Решение проблемы с помощью СИМВОЛ(34) в Excel

Перед двойной кавычкой была написана следующая конструкция:

& СИМВОЛ(34) & // (амперсанд СИМВОЛ(34) амперсанд)

Почему (34) спросите вы? Функция СИМВОЛ в качестве аргумента принимает число от 1 до 255 включительно, а 34 это как раз и есть двойная кавычка(«). Вы скажите что можно было написать =»h2 style=» » «text-align: center;», но увы — этот фокус не работает. СИМВОЛ(34) экранирует последующую кавычку, и формула не выдает ошибку.

Как получилось у меня:

="<h2 style="&СИМВОЛ(34)&"text-align: center;"&СИМВОЛ(34)&">
<span style="&СИМВОЛ(34)&"color: #ff0000;"&СИМВОЛ(34)&">&Лист1!B2&"</span>
</h2>"

Финальный текст Excel=HTML+СИМВОЛ(34)

="<html>"
="<head>"
="<title>"&Лист1!B1&"</title>"
="</head>"
="<body>"
="<h2 style="&СИМВОЛ(34)&"text-align: center;"&СИМВОЛ(34)&">
<span style="&СИМВОЛ(34)&"color: #ff0000;"&СИМВОЛ(34)&">&Лист1!B2&"</span>
</h2>"
="<p>"&Лист1!B3&"</p>"
="</body>"
="</html>"

Для того что бы просмотреть все значения функции СИМВОЛ, в ячейку A1 напишите 1, A2 2, протяните значения до 255 включительно, в ячейку B1 напишите =СИМВОЛ(A1) и протяните формулу.

В этом видео показано как использовать функция СИМВОЛ(34) в Excel или как верстать HTML в Excel:

Рекомендуем смотреть видео в полноэкранном режиме, в настойках качества выбирайте 1080 HD, не забывайте подписываться на канал в YouTube, там Вы найдете много интересного видео, которое выходит достаточно часто. Приятного просмотра!

 С уважением, авторы сайта Компьютерапия

Понравилась статья? Поделитесь ею с друзьями и напишите отзыв в комментариях!

Nice! Very slick.

I was disappointed that Excel doesn’t let us paste to a merged cell and also pastes results containing a break into successive rows below the «target» cell though, as that meant it simply doesn’t work for me. I tried a few tweaks (unmerge/remerge, etc.) but then Excel dropped anything below a break, so that was a dead end.

Ultimately, I came up with a routine that’ll handle simple tags and not use the «native» Unicode converter that is causing the issue with merged fields. Hope others find this useful:

Public Sub AddHTMLFormattedText(rngA As Range, strHTML As String, Optional blnShowBadHTMLWarning As Boolean = False)
    ' Adds converts text formatted with basic HTML tags to formatted text in an Excel cell
    ' NOTE: Font Sizes not handled perfectly per HTML standard, but I find this method more useful!

    Dim strActualText As String, intSrcPos As Integer, intDestPos As Integer, intDestSrcEquiv() As Integer
    Dim varyTags As Variant, varTag As Variant, varEndTag As Variant, blnTagMatch As Boolean
    Dim intCtr As Integer
    Dim intStartPos As Integer, intEndPos As Integer, intActualStartPos As Integer, intActualEndPos As Integer
    Dim intFontSizeStartPos As Integer, intFontSizeEndPos As Integer, intFontSize As Integer

    varyTags = Array("<b>", "</b>", "<i>", "</i>", "<u>", "</u>", "<sub>", "</sub>", "<sup>", "</sup>")

    ' Remove unhandled/unneeded tags, convert <br> and <p> tags to line feeds
    strHTML = Trim(strHTML)
    strHTML = Replace(strHTML, "<html>", "")
    strHTML = Replace(strHTML, "</html>", "")
    strHTML = Replace(strHTML, "<p>", "")
    While LCase(Right$(strHTML, 4)) = "</p>" Or LCase(Right$(strHTML, 4)) = "<br>"
        strHTML = Left$(strHTML, Len(strHTML) - 4)
        strHTML = Trim(strHTML)
    Wend
    strHTML = Replace(strHTML, "<br>", vbLf)
    strHTML = Replace(strHTML, "</p>", vbLf)

    strHTML = Trim(strHTML)

    ReDim intDestSrcEquiv(1 To Len(strHTML))
    strActualText = ""
    intSrcPos = 1
    intDestPos = 1
    Do While intSrcPos <= Len(strHTML)
        blnTagMatch = False
        For Each varTag In varyTags
            If LCase(Mid$(strHTML, intSrcPos, Len(varTag))) = varTag Then
                blnTagMatch = True
                intSrcPos = intSrcPos + Len(varTag)
                If intSrcPos > Len(strHTML) Then Exit Do
                Exit For
            End If
        Next
        If blnTagMatch = False Then
            varTag = "<font size"
            If LCase(Mid$(strHTML, intSrcPos, Len(varTag))) = varTag Then
                blnTagMatch = True
                intEndPos = InStr(intSrcPos, strHTML, ">")
                intSrcPos = intEndPos + 1
                If intSrcPos > Len(strHTML) Then Exit Do
            Else
                varTag = "</font>"
                If LCase(Mid$(strHTML, intSrcPos, Len(varTag))) = varTag Then
                    blnTagMatch = True
                    intSrcPos = intSrcPos + Len(varTag)
                    If intSrcPos > Len(strHTML) Then Exit Do
                End If
            End If
        End If
        If blnTagMatch = False Then
            strActualText = strActualText & Mid$(strHTML, intSrcPos, 1)
            intDestSrcEquiv(intSrcPos) = intDestPos
            intDestPos = intDestPos + 1
            intSrcPos = intSrcPos + 1
        End If
    Loop

    ' Clear any bold/underline/italic/superscript/subscript formatting from cell
    rngA.Font.Bold = False
    rngA.Font.Underline = False
    rngA.Font.Italic = False
    rngA.Font.Subscript = False
    rngA.Font.Superscript = False

    rngA.Value = strActualText

    ' Now start applying Formats!"
    ' Start with Font Size first
    intSrcPos = 1
    intDestPos = 1
    Do While intSrcPos <= Len(strHTML)
        varTag = "<font size"
        If LCase(Mid$(strHTML, intSrcPos, Len(varTag))) = varTag Then
            intFontSizeStartPos = InStr(intSrcPos, strHTML, """") + 1
            intFontSizeEndPos = InStr(intFontSizeStartPos, strHTML, """") - 1
            If intFontSizeEndPos - intFontSizeStartPos <= 3 And intFontSizeEndPos - intFontSizeStartPos > 0 Then
                Debug.Print Mid$(strHTML, intFontSizeStartPos, intFontSizeEndPos - intFontSizeStartPos + 1)
                If Mid$(strHTML, intFontSizeStartPos, 1) = "+" Then
                    intFontSizeStartPos = intFontSizeStartPos + 1
                    intFontSize = 11 + 2 * Mid$(strHTML, intFontSizeStartPos, intFontSizeEndPos - intFontSizeStartPos + 1)
                ElseIf Mid$(strHTML, intFontSizeStartPos, 1) = "-" Then
                    intFontSizeStartPos = intFontSizeStartPos + 1
                    intFontSize = 11 - 2 * Mid$(strHTML, intFontSizeStartPos, intFontSizeEndPos - intFontSizeStartPos + 1)
                Else
                    intFontSize = Mid$(strHTML, intFontSizeStartPos, intFontSizeEndPos - intFontSizeStartPos + 1)
                End If
            Else
                ' Error!
                GoTo HTML_Err
            End If
            intEndPos = InStr(intSrcPos, strHTML, ">")
            intSrcPos = intEndPos + 1
            intStartPos = intSrcPos
            If intSrcPos > Len(strHTML) Then Exit Do
            While intDestSrcEquiv(intStartPos) = 0 And intStartPos < Len(strHTML)
                intStartPos = intStartPos + 1
            Wend
            If intStartPos >= Len(strHTML) Then GoTo HTML_Err ' HTML is bad!
            varEndTag = "</font>"
            intEndPos = InStr(intSrcPos, LCase(strHTML), varEndTag)
            If intEndPos = 0 Then GoTo HTML_Err ' HTML is bad!
            While intDestSrcEquiv(intEndPos) = 0 And intEndPos > intSrcPos
                intEndPos = intEndPos - 1
            Wend
            If intEndPos > intSrcPos Then
                intActualStartPos = intDestSrcEquiv(intStartPos)
                intActualEndPos = intDestSrcEquiv(intEndPos)
                rngA.Characters(intActualStartPos, intActualEndPos - intActualStartPos + 1) _
                    .Font.Size = intFontSize
            End If
        End If
        intSrcPos = intSrcPos + 1
    Loop

    'Now do remaining tags
    intSrcPos = 1
    intDestPos = 1
    Do While intSrcPos <= Len(strHTML)
        If intDestSrcEquiv(intSrcPos) = 0 Then
            ' This must be a Tag!
            For intCtr = 0 To UBound(varyTags) Step 2
                varTag = varyTags(intCtr)
                intStartPos = intSrcPos + Len(varTag)
                While intDestSrcEquiv(intStartPos) = 0 And intStartPos < Len(strHTML)
                    intStartPos = intStartPos + 1
                Wend
                If intStartPos >= Len(strHTML) Then GoTo HTML_Err ' HTML is bad!
                If LCase(Mid$(strHTML, intSrcPos, Len(varTag))) = varTag Then
                    varEndTag = varyTags(intCtr + 1)
                    intEndPos = InStr(intSrcPos, LCase(strHTML), varEndTag)
                    If intEndPos = 0 Then GoTo HTML_Err ' HTML is bad!
                    While intDestSrcEquiv(intEndPos) = 0 And intEndPos > intSrcPos
                        intEndPos = intEndPos - 1
                    Wend
                    If intEndPos > intSrcPos Then
                        intActualStartPos = intDestSrcEquiv(intStartPos)
                        intActualEndPos = intDestSrcEquiv(intEndPos)
                        With rngA.Characters(intActualStartPos, intActualEndPos - intActualStartPos + 1).Font
                            If varTag = "<b>" Then
                                .Bold = True
                            ElseIf varTag = "<i>" Then
                                .Italic = True
                            ElseIf varTag = "<u>" Then
                                .Underline = True
                            ElseIf varTag = "<sup>" Then
                                .Superscript = True
                            ElseIf varTag = "<sub>" Then
                                .Subscript = True
                            End If
                        End With
                    End If
                    intSrcPos = intSrcPos + Len(varTag) - 1
                    Exit For
                End If
            Next
        End If
        intSrcPos = intSrcPos + 1
        intDestPos = intDestPos + 1
    Loop
Exit_Sub:
    Exit Sub
HTML_Err:
    ' There was an error with the Tags. Show warning if requested.
    If blnShowBadHTMLWarning Then
        MsgBox "There was an error with the Tags in the HTML file. Could not apply formatting."
    End If
End Sub

Note this doesn’t care about tag nesting, instead only requiring a close tag for every open tag, and assuming the close tag nearest the opening tag applies to the opening tag. Properly nested tags will work fine, while improperly nested tags will not be rejected and may or may not work.

  • Интернет
  • Разное

В данной статье приведён код 2 функций, которые позволят вам найти на веб-странице нужные HTML теги,
и преобразовать HTML в текст

Особенность этого кода, — использование регулярных выражений (Regexp) для поиска в HTML

Эти функции лежат в основе моей надстройки «Парсер сайтов»

Пример использования:

' в переменной txt находится исходный код веб-страницы (целиком, или его часть)

' ищем div id="mod-lists", и берем его начинку (innerHTML)
' Индекс 1 после innerHTML означает, что если будет найдено несколько таких тегов, - макрос возьмет только первый
res = GetTags(txt, "div", "id", "mod-lists", "innerHTML 1")
 
 
' ищем ВСЕ теги span класса product (функция вернёт массив значений в переменную arr)
arr = Split(GetTags(txt, "span", "class", "product", "outerHTML"), ARSEP)
 
 
' ищем гиперссылку (тег a класса blue-link), и возвращаем атрибут href
link$ = GetTags(txt, "a", "class", "blue-link", "href")
 
 
' ищем ЛЮБОЙ ТЕГ класса price, и берем последний найденный (last), преобразовав его в текст (ConvertToText)
price = GetTags(txt, "any tag", "class", "price", "ConvertToText last")

Есть возможность удалять теги из HTML (параметр DeleteTags), а также использовать подстановочный символ * до или после значения атрибута.
Можно также выполнять поиск по маске для атрибутов:

' в переменной txt находится исходный код веб-страницы (целиком, или его часть)

' удаляем все div, где имя класса начинается с old
txt = GetTags(txt, "div", "class", "old*", "DeleteTags")
 
 
' ищем ВСЕ гиперссылки по маске /item/
links_array = Split(GetTags(txt, "a", "AttributesPattern", "*/item/*", "href"), ARSEP)

Функцией преобразования HTML в текст (ConvertHTMLtoText) можно воспользоваться отдельно (без функции GetTags)

Весь приведённый ниже код, скопируйте в отдельный стандартный модуль

'---------------------------------------------------------------------------------------
' Module        : modHTML                          excelvba.ru/programmes/Parser
' Author        : Igor Vakhnenko                   Date: 21.02.2016
' info @ excelvba.ru                               Skype: ExcelVBA.ru
'---------------------------------------------------------------------------------------

Public Const ARSEP$ = "%~$"
 
Function REGEXP()
    On Error Resume Next
    Static REGEXP_ As Object
    If REGEXP_ Is Nothing Then Set REGEXP_ = CreateObject("VBScript.RegExp"): REGEXP_.Global = True
    Set REGEXP = REGEXP_
End Function
 
Function GetTags(ByVal txt$, ByVal TagName$, Optional ByVal AttrName$, Optional ByVal AttrValue$, Optional ByVal Result$ = "outerHTML") As String
    ' функция выполняет поиск заданного HTML-тега (или атрибута тега) в HTML коде
    On Error Resume Next
    Dim res$, Pattern$, SelfClosing As Boolean, NeedContent As Boolean, ResultType$, ResultIndex$, ResultsCount&, ind&
    Dim PatternPrefix$, PatternSuffix$, AttrValuePattern$, Add_URL_Prefix$
    Const SelfClosingTags = ",area,base,basefont,br,col,frame,hr,img,input,isindex,link,meta,param,embed,"
    Const ASTERISK_PATTERN = "[A-Za-z0-9_-]*"
    AttrName$ = Trim(AttrName$): AttrValue$ = Trim(AttrValue$): TagName$ = Trim(TagName$)
    If TagName$ = "Any Tag" Then TagName$ = "[a-zA-Z1-6]+"
    If TagName$ = "" Then GetTags = "GetTags ERROR: 'TagName' parameter is blank": Exit Function
 
    If InStr(1, AttrValue$, "*") Then
        If AttrValue$ Like "[*]*" Then AttrValue$ = ASTERISK_PATTERN & Mid(AttrValue$, 2)
        If AttrValue$ Like "*[A-Za-z0-9_-][*]" Then AttrValue$ = Left(AttrValue$, Len(AttrValue$) - 1) & ASTERISK_PATTERN
    End If
    PatternPrefix$ = "<(" & TagName$ & ")b"
    PatternSuffix$ = "[^>]*>"
    Select Case True
        Case AttrName$ & AttrValue$ = ""        ' поиск заданных тегов
            Pattern$ = PatternPrefix$ & PatternSuffix$
 
        Case AttrName$ = "AttributesPattern"        ' поиск тега по шаблону regexp для его заголовка
            If InStr(1, AttrValue$, ">") + InStr(1, AttrValue$, "<") Then _
               GetTags = "GetTags ERROR: 'AttributeValue' parameter contains unacceptable symbols ('<' or '>')": Exit Function
            Pattern$ = PatternPrefix$ & "[^>]*" & AttrValue$ & PatternSuffix$
 
        Case Else        ' поиск тегов по атрибуту name / id / class
            AttrValuePattern$ = "(?:(?:" & AttrValue$ & "b)|(?:['""](|[^<>'""]* )b" & AttrValue$ & "b(| [^<>'""]*)['""]))"
            Pattern$ = PatternPrefix$ & "[^>]*b" & AttrName$ & "s*=s*" & AttrValuePattern$ & PatternSuffix$
    End Select
 
    Result$ = Application.Trim(Result$): If Result$ = "" Then GetTags = "GetTags ERROR: 'Result' parameter is blank": Exit Function
    ResultType$ = Split(Result$)(0)
    ResultIndex$ = Split(Result$, , 2)(1)
 
 
    SelfClosing = SelfClosingTags Like "*," & TagName$ & ",*"
    NeedContent = InStr(1, "|innerHTML|outerHTML|ConvertToText|DeleteTags|", "|" & ResultType$ & "|") > 0
 
    Dim v, content$, cnt&, i&, TextAfterHeader$, TagHeader$, attr$, txtlen&, NN&
    With REGEXP
        .IgnoreCase = True: .Pattern = Pattern$
StartSearching:
        If .test(txt) Then
            For Each v In .Execute(txt)
                DoEvents
                TagHeader$ = "": TagHeader$ = v.Value
 
                If NeedContent And Not SelfClosing Then
                    TagName$ = v.submatches.Item(0)
                    TextAfterHeader$ = "": TextAfterHeader$ = Mid(txt, v.FirstIndex + Len(TagHeader$) + 1)
                    content$ = GetTagInnerHTML(TextAfterHeader$, TagName$)
                    If (ResultType$ = "outerHTML") Or (ResultType$ = "DeleteTags") Then
                        content$ = TagHeader$ & content$ & "</" & TagName$ & ">"
                    End If
                Else
                    content$ = TagHeader$
                End If
                Select Case ResultType$
                    Case "innerHTML", "outerHTML", "TagHeaderOnly"        ' do nothing
                    Case "DeleteTags"
                        txtlen& = Len(txt): txt = Replace(txt, content$, "")
                         ' защита от зацикливания, - если замена не выполнилась, то больше не пытаемся
                       content$ = "": If Len(txt) < txtlen& Then GoTo StartSearching
                    Case "ConvertToText"        ' convert to text
                        content$ = ConvertHTMLtoText(content$)
                    Case Else        ' get attribute value
                        attr$ = "": content$ = Split(content$, ">")(0)
                        content$ = Replace(Replace(content$, "= ", "="), " =", "=")
                        attr$ = Trim(Split(content$, " " & ResultType$ & "=", 2)(1))
                        Select Case Mid(attr$, 1, 1)
                            Case """", "'": attr$ = Split(attr$, Mid(attr$, 1, 1))(1)
                            Case Else: attr$ = Split(attr$, " ")(0)
                        End Select
                        content$ = ConvertHTMLtoText(attr$)        ' для замены  &amp; на & (и подобных других замен)
                       
                End Select
 
                If Len(content$) Then
                    ResultsCount& = ResultsCount& + 1
                    GetTags = GetTags & IIf(Len(GetTags), ARSEP, "") & content$
                    If Val(ResultIndex$) Then If Val(ResultIndex$) = ResultsCount& Then GetTags = content$: Exit Function
                End If
            Next
        End If
    End With
 
    If ResultType$ = "DeleteTags" Then GetTags = txt: Exit Function
 
    If ResultIndex$ = "join" Then GetTags = Replace(GetTags, ARSEP, vbNewLine): Exit Function
 
    If Len(ResultIndex$) * Len(GetTags) Then        ' если указан номер элемента массива
        If InStr(1, ResultIndex$, "last", vbTextCompare) > 0 Then
            ind& = UBound(Split(GetTags, ARSEP)) + Val(Split(ResultIndex$, "last")(1))
        Else
            ind& = Fix(Val(ResultIndex$)) - 1
        End If
 
        If ind& >= 0 And ind& <= UBound(Split(GetTags, ARSEP)) Then
            GetTags = Split(GetTags, ARSEP)(ind&)
        Else
            GetTags = ""
        End If
    End If
End Function
Function GetTagInnerHTML(ByVal txt$, ByVal TagName$) As String
    On Error Resume Next
    Dim ClosingTag$, arr, i&, nOPENING&
    ClosingTag$ = "</" & TagName$ & ">"
    If InStr(1, txt, ClosingTag$, vbTextCompare) = 0 Then Exit Function
    arr = Split(txt, ClosingTag$, , vbTextCompare)
    For i = LBound(arr) To UBound(arr) - 1        ' если убрать -1, то будет выводить и содержимое незакрытого тега (до конца текста в txt$)
        If Len(arr(i)) Then
            nOPENING& = nOPENING& + UBound(Split(arr(i), "<" & TagName$ & ">")) + UBound(Split(arr(i), "<" & TagName$ & " "))
        End If
        GetTagInnerHTML = GetTagInnerHTML & arr(i) & IIf(nOPENING& <> i, ClosingTag$, "")
        If nOPENING& = i Then Exit Function
    Next i
    GetTagInnerHTML = ""
End Function
Function ConvertHTMLtoText(ByVal txt$, Optional RemoveExtraLF As Boolean = False) As String
    ' Функция преобразует HTML в текст без использования DOM
    ' Создание функции было обусловлено утечками памяти при использовании библиотеки MSHTML
    On Error Resume Next
    Const HTML_SP$ = "nbsp=32;pound=163;euro=8364;para=182;sect=167;copy=169;reg=174;trade=8482;deg=176;plusmn=177;frac14=188;frac12=189;" & _
          "frac34=190;times=215;divide=247;fnof=402;Alpha=913;Beta=914;Gamma=915;Delta=916;Epsilon=917;Zeta=918;Eta=919;Theta=920;" & _
          "Iota=921;Kappa=922;Lambda=923;Mu=924;Nu=925;Xi=926;Omicron=927;Pi=928;Rho=929;Sigma=931;Tau=932;Upsilon=933;Phi=934;" & _
          "Chi=935;Psi=936;Omega=937;alpha=945;beta=946;gamma=947;delta=948;epsilon=949;zeta=950;eta=951;theta=952;iota=953;kappa=954;" & _
          "lambda=955;mu=956;nu=957;xi=958;omicron=959;pi=960;rho=961;sigma=963;tau=964;upsilon=965;phi=966;chi=967;psi=968;omega=969;" & _
          "sigmaf=962;larr=8592;uarr=8593;rarr=8594;darr=8595;harr=8596;spades=9824;clubs=9827;hearts=9829;" & _
          "diams=9830;quot=34;amp=38;lt=60;gt=62;hellip=8230;prime=8242;ndash=8211;mdash=8212;lsquo=8216;rsquo=8217;sbquo=8218;" & _
          "ldquo=8220;rdquo=8221;bdquo=8222;laquo=171;raquo=187;ensp=8194;emsp=8195;shy=173;ordm=186;ordf=170;permil=8240;brvbar=166;" & _
          "micro=181;oline=8254;acute=180;sup1=185;sup2=178;sup3=179;not=172;frasl=8260;minus=8722;le=8804;ge=8805;asymp=8776;ne=8800;" & _
          "equiv=8801;radic=8730;infin=8734;sum=8721;prod=8719;part=8706;int=8747;forall=8704;exist=8707;empty=8709;Oslash=216;" & _
          "isin=8712;notin=8713;ni=8727;sub=8834;sup=8835;nsub=8836;sube=8838;supe=8839;oplus=8853;otimes=8855;perp=8869;ang=8736;" & _
          "and=8743;or=8744;cap=8745;cup=8746;cent=162;current=164;yen=165;bull=8226;middot=183;loz=9674;crarr=8629"
 
    Const ADD_TAB$ = "</th><th>,</td><td>"
    Const ADD_NL$ = "<div>,<p>,<table>,</table>,<img>,<h1>,<h2>,<h3>,<h4>,<h5>,<h6>,<br>,<hr>,</tr>,</li>,<dl>,<dt>"
 
    Dim Tag, char, arr, cnt&, i&
    With REGEXP
 
        ' удаляем все комменты из HTML
        If txt$ Like "*<!--*-->*" Then
            arr = "": arr = Split(txt, "<!--")
            For i = LBound(arr) + 1 To UBound(arr)
                cnt& = 0: cnt& = UBound(Split(arr(i), "-->"))
                If cnt& = 0 Then arr(i) = "" Else arr(i) = Split(arr(i), "-->")(cnt&)
            Next i
            txt = Join(arr, "")
        End If
        txt$ = CloseUnclosedTags(txt$)
        ' очистка тегов
        .Pattern = "(<[A-Za-z1-6]+)[^<>]*(>)"
        txt$ = .Replace(txt$, "$1$2")        ' удаляем все атрибуты у тегов
        .Pattern = ">s*<"
        txt$ = .Replace(txt$, "><")        ' удаляем пробелы и переводы строк между тегами

        ' удаляем все скрипты
        If txt$ Like "*<script>*</script>*" Then
            arr = "": arr = Split(txt, "<script>")
            For i = LBound(arr) + 1 To UBound(arr)
                cnt& = 0: cnt& = UBound(Split(arr(i), "</script>"))
                If cnt& = 0 Then arr(i) = "" Else arr(i) = Split(arr(i), "</script>")(cnt&)
            Next i
            txt = Join(arr, "")
        End If
 
        ' берём содержимое тега <body>
        If txt Like "*<body>*" Then txt = Split(txt, "<body>")(1)
 
        txt = Replace(txt, vbNewLine, vbLf): txt = Replace(txt, vbLf, vbNewLine)
        MultiReplace txt, "<br>" & vbNewLine, "<br>"
        MultiReplace txt, vbNewLine & "<br>", "<br>"
 
        ' добавляем переводы строк и табуляцию между ячейками таблиц
        For Each Tag In Split(ADD_NL$, ",")
            txt = Replace(txt, Tag, vbNewLine, , , vbTextCompare)
        Next Tag
        For Each Tag In Split(ADD_TAB$, ",")
            txt = Replace(txt, Tag, vbTab, , , vbTextCompare)
        Next Tag
 
        ' удаляем оставшиеся теги
        .Pattern = "<[^<>]+>"
        txt$ = .Replace(txt$, "")
        ' заменяем коды спецсимволов на сами символы
        For Each char In Split(HTML_SP$, ";")        ' сначала - символы, которые имеют названия типа &сopy; и &nbsр;
            If InStr(1, txt$, Split(char, "=")(0), vbBinaryCompare) Then
                txt$ = Replace(txt$, "&" & Split(char, "=")(0) & ";", ChrW(Val(Split(char, "=")(1))), , , vbBinaryCompare)
            End If
        Next char
        .Pattern = "&#(d{2,5});"        ' а теперь - спецсимволы, представленные кодами вида &#84l0;
        If .test(txt$) Then
            For Each char In .Execute(txt)
                txt$ = Replace(txt$, char.Value, ChrW(Val(char.submatches.Item(0))))
            Next
        End If
 
        ' убираем лишние переводы строк, пробелы и табуляторы
        MultiReplace txt, " " & vbTab, vbTab: MultiReplace txt, vbTab & " ", vbTab
        MultiReplace txt, vbTab & vbNewLine, vbNewLine: MultiReplace txt, vbNewLine & vbTab, vbNewLine
        MultiReplace txt$, vbNewLine & vbNewLine & vbNewLine, vbNewLine & vbNewLine
        MultiReplace txt, vbNewLine & " " & vbNewLine, vbNewLine
        MultiReplace txt, " " & vbNewLine, vbNewLine
 
        If RemoveExtraLF Then MultiReplace txt$, vbNewLine & vbNewLine, vbNewLine
 
        While txt$ Like "*" & vbNewLine: txt = Left(txt, Len(txt) - Len(vbNewLine)): Wend
        While txt$ Like vbNewLine & "*": txt = Mid(txt, Len(vbNewLine) + 1): Wend
 
    End With
    Erase arr: Err.Clear
    ConvertHTMLtoText = txt$
End Function
Sub MultiReplace(ByRef txt$, ByVal Find$, ByVal Replacement$)
    On Error Resume Next: Dim n&
    If InStr(1, Replacement$, Find$, vbBinaryCompare) Then Exit Sub        ' чтобы избежать зацикливания и переполнения
    While (InStr(1, txt$, Find$, vbBinaryCompare) > 0) And (n < 100)
        n = n + 1: txt$ = Replace(txt$, Find$, Replacement$)
    Wend
End Sub
 
Function CloseUnclosedTags(ByVal txt$) As String
    On Error Resume Next: CloseUnclosedTags = txt$: Dim char
    With REGEXP
        .Pattern = "(<[A-Za-z1-6]+b[^<>]*)(<[A-Za-z1-6]+b)"
        If .test(txt$) Then CloseUnclosedTags = .Replace(txt$, "$1>$2")
    End With
End Function
  • 22854 просмотра

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.

Как показано на скриншоте ниже, если в ячейках вашего рабочего листа есть несколько html-тегов, как вы могли бы преобразовать их в простой текст в Excel? В этой статье будут показаны два метода удаления всех тегов html из ячеек Excel.

Преобразование html в текст в выбранных ячейках с помощью функции поиска и замены
Преобразование html в текст на всем листе с помощью VBA


Преобразование html в текст в ячейках с помощью функции поиска и замены

Вы можете преобразовать весь HTML в текст в ячейках с помощью Найти и заменить функция в Excel. Пожалуйста, сделайте следующее.

1. Выберите ячейки, в которых вы преобразуете весь HTML-код в текст, и нажмите Ctrl + F , чтобы открыть Найти и заменить диалоговое окно.

2. в Найти и заменить диалогового окна, перейдите к Замените вкладка, введите <*> в Найти то, что коробка, держи Заменить пустое поле и щелкните Заменить все кнопка. Смотрите скриншот:

3. Затем Microsoft Excel появится диалоговое окно, в котором указано, сколько тегов html было заменено, щелкните значок OK кнопку и закройте Найти и заменить диалоговое окно.

Затем вы можете увидеть, что все теги html удалены из выбранных ячеек, как показано ниже.


Преобразование html в текст на всем листе с помощью VBA

Кроме того, вы можете конвертировать весь HTML в текст на всем листе одновременно с помощью приведенного ниже кода VBA.

1. Откройте рабочий лист, содержащий HTML-код, который вы преобразуете в текст, затем нажмите другой + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

2. в Microsoft Visual Basic для приложений окна, нажмите Вставить > Модули, затем скопируйте ниже код VBA в окно модуля.

Код VBA: преобразование HTML в текст на всем листе

Sub RemoveHTMLTags()
'Update by Extendoffice 20180703
    Dim xRg As Range
    Dim xCell As Range
    Dim xStr As String
    Dim xRegEx As RegExp
    Dim xMatch As Match
    Dim xMatches As MatchCollection
    Set xRegEx = New RegExp
    Application.EnableEvents = False
    Set xRg = Cells.SpecialCells(xlCellTypeConstants)
    With xRegEx
        .Global = True
        .Pattern = "<(""[^""]*""|'[^']*'|[^'"">])*>"
    End With
    For Each xCell In xRg
        xStr = xCell.Value
            Set xMatches = xRegEx.Execute(xCell.Text)
            For Each xMatch In xMatches
                xStr = Replace(xStr, xMatch.Value, "")
            Next
        xCell.Value = xStr
    Next
   Application.EnableEvents = True
End Sub

3. Все еще в Microsoft Visual Basic для приложений окно, пожалуйста, нажмите Tools
> Рекомендации, проверить Регулярное выражение Microsoft VBScript 5.5 вариант в Ссылки-VBAProject диалоговое окно, а затем щелкните значок OK кнопку.

4. нажмите F5 или нажмите кнопку «Выполнить», чтобы запустить код.

Затем все теги html сразу удаляются со всего рабочего листа.


Статьи по теме:

  • Как массово преобразовать числа, хранящиеся в виде текста, в числа в Excel?

Лучшие инструменты для работы в офисе

Kutools for Excel Решит большинство ваших проблем и повысит вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма …
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы… Предотвращение дублирования ячеек; Сравнить диапазоны
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор …
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое …
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом …
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.

вкладка kte 201905


Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!

офисный дно

Комментарии (4)


Номинальный 5 из 5


·


рейтинги 1

Я пытаюсь понять, как добавить, например,

и

в начало и конец данных моей ячейки. Итак, мои данные выглядят так, например:

Раньше: Лос-Анджелес

После:

Лос-Анджелес

У меня есть целая таблица с тоннами контента, который нужно преобразовать таким образом. Я был бы признателен за помощь

2 ответа

Лучший ответ

Excel — не лучший инструмент для создания HTML.

Если вы хотите объединить html-теги с содержимым ячеек Excel, вы можете создать окончательную html-строку с помощью оператора & между битами текста, например:

="<p>"&A1&"</p>"

Изменить: если вам нужно включить отформатированные даты в эту конструкцию, вы можете посмотреть на функцию Text (), как показано ниже. Настройте нужный формат.

=TEXT(A1,"dd mmm yyyy")

enter image description here


4

teylyn
9 Фев 2018 в 09:28

Отформатируйте значение ячейки с помощью ТЕКСТА, используя маску настраиваемого формата. Обратную косую черту можно использовать как escape-символ, чтобы избежать конфликта с зарезервированными символами форматирования.

=TEXT(A1, "<p>@</p>")

Эту маску формата также можно использовать в качестве настраиваемого числового формата ячейки.

enter image description here

<p>Los Angeles</p>
<p>Melbourne</p>
<p>Vancouver</p>


1

user4039065user4039065
8 Фев 2018 в 08:36

Парсинг нетабличных данных с сайтов

Проблема с нетабличными данными

С загрузкой в Excel табличных данных из интернета проблем нет. Надстройка Power Query в Excel легко позволяет реализовать эту задачу буквально за секунды. Достаточно выбрать на вкладке Данные команду Из интернета (Data — From internet), вставить адрес нужной веб-страницы (например, ключевых показателей ЦБ) и нажать ОК:

Импорт данных с веб-страницы через Power Query

Power Query автоматически распознает все имеющиеся на веб-странице таблицы и выведет их список в окне Навигатора:

Выбираем таблицу на сайте для импорта

Дальше останется выбрать нужную таблицу методом тыка и загрузить её в Power Query для дальнейшей обработки (кнопка Преобразовать данные) или сразу на лист Excel (кнопка Загрузить).

Если с нужного вам сайта данные грузятся по вышеописанному сценарию — считайте, что вам повезло.

К сожалению, сплошь и рядом встречаются сайты, где при попытке такой загрузки Power Query «не видит» таблиц с нужными данными, т.е. в окне Навигатора попросту нет этих Table 0,1,2… или же среди них нет таблицы с нужной нам информацией. Причин для этого может быть несколько, но чаще всего это происходит потому, что веб-дизайнер при создании таблицы использовал в HTML-коде страницы не стандартную конструкцию с тегом <TABLE>, а её аналог — вложенные друг в друга теги-контейнеры <DIV>. Это весьма распространённая техника при вёрстке веб-сайтов, но, к сожалению, Power Query пока не умеет распознавать такую разметку и загружать такие данные в Excel.

Тем не менее, есть способ обойти это ограничение ;)

В качестве тренировки, давайте попробуем загрузить цены и описания товаров с маркетплейса Wildberries — например, книг из раздела Детективы:

Детективы на Wildberries

Загружаем HTML-код вместо веб-страницы

Сначала используем всё тот же подход — выбираем команду Из интернета на вкладке Данные (Data — From internet) и вводим адрес нужной нам страницы:

https://www.wildberries.ru/catalog/knigi/hudozhestvennaya-literatura/detektivy

После нажатия на ОК появится окно Навигатора, где мы уже не увидим никаких полезных таблиц, кроме непонятной Document:

Навигатор без таблиц

Дальше начинается самое интересное. Жмём на кнопку Преобразовать данные (Transform Data), чтобы всё-таки загрузить содержимое таблицы Document в редактор запросов Power Query. В открывшемся окне удаляем шаг Навигация (Navigation) красным крестом:

Удаляем ненужный шаг Навигация

… и затем щёлкаем по значку шестерёнки справа от шага Источник (Source), чтобы открыть его параметры:

Меняем тип файла

В выпадающием списке Открыть файл как (Open file as) вместо выбранной там по-умолчанию HTML-страницы выбираем Текстовый файл (Text file). Это заставит Power Query интерпретировать загружаемые данные не как веб-страницу, а как простой текст, т.е. Power Query не будет пытаться распознавать HTML-теги и их атрибуты, ссылки, картинки, таблицы, а просто обработает исходный код страницы как текст.

После нажатия на ОК мы этот HTML-код как раз и увидим (он может быть весьма объемным — не пугайтесь):

Исходный код страницы в Power Query

Ищем за что зацепиться

Теперь нужно понять на какие теги, атрибуты или метки в коде мы можем ориентироваться, чтобы извлечь из этой кучи текста нужные нам данные о товарах. Само-собой, тут всё зависит от конкретного сайта и веб-программиста, который его писал и вам придётся уже импровизировать.

В случае с Wildberries, промотав этот код вниз до товаров, можно легко нащупать простую логику:

Изучаем исходный код

  • Строчки с ценами всегда содержат метку lower-price
  • Строчки с названием бренда — всегда с меткой brand-name c-text-sm
  • Название товара можно найти по метке goods-name c-text-sm

Иногда процесс поиска можно существенно упростить, если воспользоваться инструментами отладки кода, которые сейчас есть в любом современном браузере. Щёлкнув правой кнопкой мыши по любому элементу веб-страницы (например, цене или описанию товара) можно выбрать из контекстного меню команду Инспектировать (Inspect) и затем просматривать код в удобном окошке непосредственно рядом с содержимым сайта:

Инспектирование кода HTML на веб-странице

Фильтруем нужные данные

Теперь совершенно стандартным образом давайте отфильтруем в коде страницы нужные нам строки по обнаруженным меткам. Для этого выбираем в окне Power Query в фильтре [1] опцию Текстовые фильтры — Содержит (Text filters — Contains), переключаемся в режим Подробнее (Advanced) [2] и вводим наши критерии:

Фильтруем нужные строки

Добавление условий выполняется кнопкой со смешным названием Добавить предложение [3]. И не забудьте для всех условий выставить логическую связку Или (OR) вместо И (And) в выпадающих списках слева [4] — иначе фильтрация просто не сработает.

После нажатия на ОК на экране останутся только строки с нужной нам информацией:

Отобранные строки

Чистим мусор

Останется почистить всё это от мусора любым подходящим и удобным лично вам способом (их много). Например, так:

  1. Удалить заменой на пустоту начальный тег: <span class=»price»> через команду Главная — Замена значений (Home — Replace values).
  2. Разделить получившийся столбец по первому разделителю «>» слева командой Главная — Разделить столбец — По разделителю (Home — Split column — By delimiter) и затем ещё раз разделить получившийся столбец по первому вхождению разделителя «<» слева, чтобы отделить полезные данные от тегов:

    Отделяем данные от HTML-тегов

  3. Удалить лишние столбцы, а в оставшемся заменить стандартную HTML-конструкцию &quot; на нормальные кавычки.

В итоге получим наши данные в уже гораздо более презентабельном виде:

Зачищенные данные

Разбираем блоки по столбцам

Если присмотреться, то информация о каждом отдельном товаре в получившемся списке сгруппирована в блоки по три ячейки. Само-собой, нам было бы гораздо удобнее работать с этой таблицей, если бы эти блоки превратились в отдельные столбцы: цена, бренд (издательство) и наименование.

Выполнить такое преобразование можно очень легко — с помощью, буквально, одной строчки кода на встроенном в Power Query языке М. Для этого щёлкаем по кнопке fx в строке формул (если у вас её не видно, то включите её на вкладке Просмотр (View)) и вводим следующую конструкцию:

= Table.FromRows(List.Split(#»Замененное значение1″[Column1.2.1],3))

Здесь функция List.Split разбивает столбец с именем Column1.2.1 из нашей таблицы с предыдущего шага #»Замененное значение1″ на кусочки по 3 ячейки, а потом функция Table.FromRows конвертирует получившиеся вложенные списки обратно в таблицу — уже из трёх столбцов:

Разобранная на 3 столбца таблица

Ну, а дальше уже дело техники — настроить числовые форматы столбцов, переименовать их и разместить в нужном порядке. И выгрузить получившуюся красоту обратно на лист Excel командой Главная — Закрыть и загрузить (Home — Close & Load…)

Загруженные в Excel данные с сайта

Вот и все хитрости :)

Ссылки по теме

  • Импорт курса биткойна с сайта через Power Query
  • Парсинг текста регулярными выражениями (RegExp) в Power Query
  • Параметризация путей к данным в Power Query

Like this post? Please share to your friends:
  • Html таблица для excel
  • Html таблица в excel python
  • I asked him what the word means meant
  • I am woman spoken word
  • I am the word study group