Удалить часть строки из одного набора символов в другой символ

Question

У меня есть лист Excel, в котором я хочу удалить некоторые теги HTML. Моя проблема в том, что некоторые из тегов не просто простые теги <div>, но имеют дополнительные символы, такие как <div class="ExternalClassEA74AB3F178E48EDAD3BDE4FC90B1182"> Заменить с <div, пока мы не достигнем конца > тега. Как заменить строковые части, например, на «». Спасибо.

Answer 1

Sub RemoveDivs()
    Dim html$
    html = "Some other text<div class=""ExternalClassEA74AB3F178E48EDAD3BDE4FC90B1182""> and here too"
    With CreateObject("VBScript.RegExp")
        .Pattern = "<div.*?>": .Global = True
        html = .Replace(html, "")
    End With
    MsgBox html
End Sub

Answer 2

Это не идеальное решение, и, скорее всего, не удастся сделать то, что вы ожидаете, если у вас есть < или > в качестве фактического текста, который вы хотите сохранить.

Это должно дать вам отправную точку и должно быть в состоянии внести некоторые изменения для достижения "совершенства".

Смотрите комментарии для более подробной информации:

Sub htmlStrip()

Dim ws As Worksheet: Set ws = ActiveWorkbook.Sheets("Sheet Name Here") '<- set sheet name
Dim lRow As Long: lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row 'get last row
Dim lCol As Long: lCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column 'get last column

Dim arrData As Variant: arrData = ws.Range("A1").Resize(lRow, lCol) 'get the data into an array
Dim R As Long, C As Long, X As Long, Z As Long

Const sS As String = "<" 'html tag start
Const sE As String = ">" 'html tag end

Dim lS As Long, lE As Long, lCnt As Long, lECnt As Long
Dim strTmpS As String, strTmpE As String, strTemp As String, strReplace As String


For R = LBound(arrData) To UBound(arrData) 'iterate through all rows of data
    For C = LBound(arrData, 2) To UBound(arrData, 2) 'iterate through all columns of data
        lS = InStr(1, arrData(R, C), sS) 'get the location of the first tag
        lE = InStr(1, arrData(R, C), sE) 'get the location of the last tag

        If lS > 0 And lE > 0 Then 'if at least one of each found
            If lE < lS Then lE = InStr(lS + 1, arrData(R, C), sE) 'prevent a case when the first tag is the ending one

            lSCnt = Len(arrData(R, C)) - Len(Replace(arrData(R, C), sS, "")) 'check how many times we have the first tag
            lECnt = Len(arrData(R, C)) - Len(Replace(arrData(R, C), sE, "")) 'check how many times we have the last tag

            Z = WorksheetFunction.Min(lSCnt, lECnt) 'avoid a situation when we have some opening or closing tags, but not the matching ones

            For X = 1 To Z 'iterate through the number of times at least both tags are in
                strReplace = Mid(arrData(R, C), lS, lE - lS + 1) 'get the string to replace
                arrData(R, C) = Replace(arrData(R, C), strReplace, "") 'remove the tag found

                lS = InStr(1, arrData(R, C), sS) 'get the location of the first tag (again)
                lE = InStr(1, arrData(R, C), sE) 'get the location of the last tag (again)

                If lS = 0 Or lE = 0 Then Exit For 'either we reached the end of the loop, or did a multi replace - so exit here
            Next X
        End If
    Next C
Next R

ws.Range("A1").Resize(lRow, lCol).Offset(0, lCol) = arrData 'put the data back on the spreadsheet, at the right of the original data

End Sub