Html 访问两个特定标题元素之间的所有li元素 问题描述：

我正在寻找一种方法来访问两个特定标题标签之间的li元素，例如从第二个h3到第三个h3或从第三个h3到下一个h4，以便创建一个根据标题中提到的标准结构化的历史事件表。 对我来说是个大问题。。。除了h1标题外，较低级别的字幕没有类名或id

HTML示例： [...] 当前位置：开始使用Amtszeit erstmals 上午1点。一月一日上午一点。马尔兹；daher是第1条。一月份的乡村乡村。 0:des endet。迪塞尔·维德ab 2。公元709年1月。 0:lässt sich vom zum “意大利元首”是一个伟大的领袖，他是一个伟大的领袖。 [...] Gesetzen和Staatsverträgen的意见[ | ] 第1条1.1月，我们经常会在一次会议上讨论这一问题

：das ABGB在书房里。 [...] 1月1日上午1时，我在乌纳巴什ängigkeit：

[...] 维特沙夫特[ | ] 世界银行的埃雷格尼塞维奇酒店 ]

---

：在erscheint die erste ungarische Zeitung Magyar hírmondó“Ungarischer Kurier”中，不使用循环，您可以立即复制和粘贴范围

Sub HistoricalEvents_Test()
    Dim http   As Object, html As New MSHTML.HTMLDocument
    Dim oUlList As MSHTML.IHTMLDOMChildrenCollection, oLiList As MSHTML.IHTMLDOMChildrenCollection
    Dim data   As String
    Dim r      As Integer
    Dim oWord  As Word.Application ' Object
    Dim oWordDoc As New Word.document ' Object
    Dim wordApp As New Word.Application
    Dim iFirstRow As Integer, iLastRow As Integer

    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://de.wikipedia.org/wiki/1._Januar", False
    http.send
    html.body.innerHTML = http.responseText
    
    'this works pretty fast, but a little reformatting on the Word document (yet to be implemented) is needed:
      
    Dim lUlResultList As Long
    Dim lUlResultLoop As Long
    
    Set oUlList = html.querySelectorAll("div.mw-parser-output ul")
    
    lUlResultList = oUlList.Length
    
    For lUlResultLoop = 0 To oUlList.Length - 1
        Dim oUlChild As Object
        Set oUlChild = oUlList.Item(lUlResultLoop)
        If Not oUlChild.FirstChild.className Like "*toclevel*" Then
            data = oUlChild.innerText             'data = data & vbCrLf & oUlChild.innerText
            Range("B" & lUlResultLoop).Value = data
            data = vbNullString
        End If
    Next lUlResultLoop
    
    
    'this works as well, no reformatting needed, but pasting to Word is much slower:
    
    '    Dim lLiResultList As Long
    '    Dim lLiResultLoop As Long
    
    '    Set oLiList = html.querySelectorAll("div.mw-parser-output ul li")
    
    '    lLiResultList = oLiList.Length
    
    '    For lLiResultLoop = 0 To oLiList.Length - 1
    '        Dim oLiChild As Object
    '        Set oLiChild = oLiList.Item(lLiResultLoop)
    '        If Not oLiChild.className Like "*toclevel*" Then
    '            data = oLiChild.innerText           'data = data & vbCrLf & oLiChild.innerText
    '            Range("B" & lLiResultLoop).Value = data
    '            data = vbNullString
    '        End If
    '    Next lLiResultLoop
    
    '********************************************************************************************
    
    Dim j      As Long
    Dim Ws As Worksheet
    Dim rngDB As Range
    Set Ws = ActiveSheet
    Set oWord = CreateObject("Word.Application")

    Set oWordDoc = oWord.Documents.Open("D:\Jahrestage Geschichte.docx")
    'Set oWordDoc = oWord.Documents.Add
    iFirstRow = Ws.Cells(1, 2).End(xlDown).Row
    'Debug.Print iFirstRow
    iLastRow = Ws.Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row
    'Debug.Print iLastRow
    oWord.Visible = True
    
    With wordApp
        With Ws
            Set rngDB = Ws.Range(.Cells(iFirstRow, 2), .Cells(iLastRow, 2))
        End With
        rngDB.Cut
            oWord.Selection.PasteSpecial DataType:=wdPasteText
            oWord.Selection.TypeParagraph
'        For r = iFirstRow To iLastRow
'            Range(Cells(r, 2), Cells(r, 2)).Cut
'            oWord.Selection.PasteSpecial DataType:=wdPasteText
'            oWord.Selection.TypeParagraph
'            For j = 1 To 4
'                Dim t  As Double
'                t = Timer
'                Do Until Timer - t >= 0.4         'can't go faster or error 4605 occurs!
'                    DoEvents
'                Loop
'            Next
            oWord.Selection.TypeParagraph
            oWord.Selection = ""
        'Next r
    End With
    
    oWordDoc.Close savechanges:=True
    wordApp.Quit                                  'it doesn't :(
    
End Sub

---

下面是一个例子，我的意思是将HTML缩小到特定标题之间的位置，并基于标题类型，例如h2标题，第一个和第二个。Css选择器用于确保h2列表仅包含所需的h2元素列表，然后从中进行位置选择，即选择；的第一项和第二项。outerHTML用于确保在元素的html保留标记结构的开始处切片，以便插入回html.body.innerHTML。然后，我使用li元素的子集html内容查询HTMLDocument

希望您能看到主体是如何扩展的。为了混合头类型，请注意css的选择性和顺序，您可以在开始时使用OR语法检索混合头节点列表，例如h2和h3将是html.querySelectorAlltoc~h2，toc~h3。请非常小心，并验证返回的节点列表是按expec排序的当使用后一种方法时，ted

请记住，有很多wiki API可以为您想要的内容提供服务，例如：

---

https://stackoverflow.com/questions/627594/is-there-a-wikipedia-api

那么，上述场景的预期输出是什么样子的？你说从第二个h3到第三个h3或从第三个h3到下一个h4-你是否希望相同的代码适用于这两种场景/其他场景？假设该部分是政治和世界事务，那么这将导致什么结果p看起来像吗？我想这是指你在标题标签之间选择一个部分？HTML文档只是一个文本，其中的元素被唯一标识。因此，你可以使用INSTR函数搜索一个元素，然后搜索另一个，它们之间的字符串包含它们之间的所有元素。是的。你可以找到tart是标题1的一部分，在那里切片，然后在下一个标题的开始处再次切片，因此您只提取了一部分html。您可能需要调整html以使其在解析时有效，例如，确保在标题标记的开始处剪切。抱歉，我误读了这一行。我的错。看起来您想要html.querySelectorAlltoc~ulNo problem！您的新html.qUERLYSELECTORALLTOC~ul非常有效。非常感谢，使用~的这种方法对我来说是全新的。多么方便！太棒了！你的解决方案也能以闪电般的速度完美工作！！非常感谢！不确定我接受这个与单词导出方面相关的答案是否意味着我关于元素选择的主要问题是两个标签之间的问题也被视为得到了回答。事实上，这还不算完全解决，但我已经收到了很多有价值的意见，可以继续开发我的项目。因此，感谢大家的反馈！这非常有帮助！正是我正在寻找的示例，并以即使像我这样的初学者都能理解的方式进行了解释。我将继续我必须将liList的声明更改为Object，否则会触发运行时错误13。不过，这似乎不会影响功能。由于某些原因，我无法解释querySelectorAll不再返回任何匹配项和hNodeList。长度始终为Null。我没有这样做对代码做了任何更改，所以我真的不知道它为什么突然停止工作。网站的html对我来说似乎也没有变化。知道问题可能是什么吗？我无法复制它。您是否按原样运行上述内容？是否与html.getelementsbyclassnammw-parser-output0.getElementsBy匹配TagNameh2？好的，我将使用它，直到我弄清楚querySelectorAll方法为什么有stop 他突然停止了工作。谢谢

Option Explicit

Public Sub SliceHtmlByHeaderTypes()
    
    Dim http As Object, html As MSHTML.HTMLDocument
    
    Set http = CreateObject("MSXML2.XMLHTTP"): Set html = New MSHTML.HTMLDocument
    http.Open "GET", "https://de.wikipedia.org/wiki/1._Januar", False
    http.send
    html.body.innerHTML = http.responseText
    
    Dim hNodeList As Object
    
    Set hNodeList = html.querySelectorAll("#toc ~ h2")
    
    Dim startPos As Long, endPos As Long
    
    startPos = InStr(html.body.outerHTML, hNodeList.Item(0).outerHTML) ' we wanna split between 1st and 2nd i.e. indices 0 and 1
    endPos = InStr(html.body.outerHTML, hNodeList.Item(1).outerHTML)
    
    Debug.Print hNodeList.Item(0).innerText
    Debug.Print hNodeList.Item(1).innerText
    
    If startPos > 0 And endPos > 0 And endPos > startPos Then
        Dim s As String
        s = Mid$(html.body.outerHTML, startPos, endPos - startPos + 1)
    Else
       MsgBox "Problem slicing string"
       Exit Sub
    End If
    
    Dim liList As MSHTML.IHTMLElementCollection
    
    html.body.innerHTML = s  'replace html content with new spliced content
    
    Set liList = html.getElementsByTagName("li") 'then do something with list of lis
    
    Stop

End Sub