Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Извлечь данные из ячейки с html-кодом
 
#1
16.11.2018 22:29:40
Добрый день. Может кто-то поможет, надо извлечь данные из ячейки. Ячейка с html-кодом. То, что необходимо извлечь - отметил цветами (каждый цвет - то, что необходимо извлечь в отдельную ячейку). Есть ли способ или не имеет смысла даже пытаться? Код примерно выглядит вот так:
Скрытый текст
 
 
 
#2
16.11.2018 23:06:48
Цитата
leskrean написал: или не имеет смысла даже пытаться?
Попытаться можно. Не очень 'гибкая' UDF
Код
Function ТЕКСТМЕЖДУ(cl, s1 As String, n1 As Long, s2 As String, n2 As Long) As String
'cl - текст, или ссылка на ячейку с текстом, откуда вырезаем текст
's1 - первый граничный символ
'n1 - номер вхождения первого символа
's2 - второй граничный символ
'n2 - номер вхождения второго символа
With Application.WorksheetFunction
    If s1 = s2 Then
         cl = .Substitute(.Substitute(cl, s1, Chr(5), n1), s2, Chr(6), n2 - 1)
         s1 = Chr(5)
         s2 = Chr(6)
         n1 = 1
         n2 = 1
    End If
    If n1 > 1 Then
        cl = .Substitute(cl, s1, Chr(5), n1)
        s1 = Chr(5)
        n1 = 1
    End If
    If n2 > 1 Then
        cl = .Substitute(cl, s2, Chr(6), n2)
        s2 = Chr(6)
        n2 = 1
    End If
    f1 = .Search(s1, CStr(cl), n1) + 1: f2 = .Search(s2, CStr(cl), n2)
    If f2 - f1 < 0 Then Exit Function
    ТЕКСТМЕЖДУ = Mid(CStr(cl), f1, f2 - f1)
End With
End Function
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
16.11.2018 23:34:28
На пробу
Код
    With CreateObject("Scripting.FileSystemObject").OpenTextFile("D:\test.html", 1, True)
        txt = .ReadAll: .Close
    End With
    txt = Replace(Replace(txt, Chr(10), ""), Chr(13), "")
    txt = Split(Split(txt, "Features:</strong>")(1), "/p>")(0)
    With CreateObject("VBScript.RegExp")
        .Global = True: .IgnoreCase = True: .Pattern = ">(.+?)<"
        If .test(txt) Then
            Set Matches = .Execute(txt)
            If Matches.Count > 0 Then
                For m = 0 To Matches.Count - 1
                    Cells(m + 1, 1) = Matches(m).SubMatches(0)
                Next
            End If
        End If
    End With
 
 
 
Страницы: 1
Наверх