VBA'yı kullanarak bir etikette HTML metnini ayrıştırma

Question

Gövde etiketinin dışında herhangi bir HTML öğesi tarafından çevrelenmeyen bazı metinler almam gerekiyor, ancak sorun, metnin diğer etiketler ve gereksinimler tarafından ayrıştırılmasıdır. Ayrı hücrelere git. Örneğin

:

Ben kendi sütunlar halinde damgaları yanı sıra isimleri elde edebilir, ama ben gelen satırlara metninin her satırı almak nasıl bulmaktan sorun yaşıyorum

<a id="00:00:00" class="ts">[00:00:00]</a> <font class="mn">Name1</font> First bit of text<br/> 
<a id="00:00:09" class="ts">[00:00:09]</a> <font class="mn">Name2</font> Second Line of Text<br/> 
<a id="00:01:17" class="ts">[00:01:17]</a> <font class="mn">Name3</font> A third line of text<br/> 
<a id="00:01:59" class="ts">[00:01:59]</a> <font class="mn">Name4</font> The final line of text<br/> 

.

İşte benim kod şimdiye kadar var:

Dim i As Integer 
Dim Timestamp As Object 
Dim Name As Object 

my_url = "path_to_url.html" 
Set html_doc = CreateObject("htmlfile") 
Set xml_obj = CreateObject("MSXML2.XMLHTTP") 

xml_obj.Open "GET", my_url, False 
xml_obj.send 
html_doc.body.innerHTML = xml_obj.responseText 
Set xml_obj = Nothing 

Set Timestamp = html_doc.body.getElementsByTagName("a") 
Set Name = html_doc.body.getElementsByTagName("font") 

i = 2 
For Each itm In Timestamp 
    If itm.getAttribute("className") = "ts" Then 
     Cells(i, 1).Value = itm.innerText 
     i = i + 1 
    End If 
Next 

i = 2 
For Each itm In Name 
    If itm.getAttribute("className") = "mn" Then 
     Cells(i, 2).Value = itm.innerText 
     i = i + 1 
    End If 
Next 

belki bir şekilde <br/> kullanarak ve SOL kullanarak düşünüyordum ama bunun en iyi yaklaşım olup olmadığından emin değilim. Şimdiden teşekkürler. Bu yanıtta yalnızca içerik ve sen böyle bir şey yapabileceğini hiç bölümler de mevcuttur olarak

Answer 1

sürece:

DÜZENLEME:

Sub Tester() 

    Const RW_START As Long = 5 
    Const SPLITTER = "{xxxx}" 
    Dim i As Integer, html_doc, itm 
    Dim Timestamp As Object 
    Dim Name As Object 
    Dim arr, sep, txt 

    Set html_doc = CreateObject("htmlfile") 
    html_doc.body.innerHTML = Range("A1").Value 'for my testing... 


    Set Timestamp = html_doc.body.getElementsByTagName("a") 
    Set Name = html_doc.body.getElementsByTagName("font") 

    i = RW_START 
    For Each itm In Timestamp 
     If itm.getAttribute("className") = "ts" Then 
      Cells(i, 1).Value = itm.innerText 
      itm.innerText = "" '<<< 
      i = i + 1 
     End If 
    Next 

    i = RW_START 
    For Each itm In Name 
     If itm.getAttribute("className") = "mn" Then 
      Cells(i, 2).Value = itm.innerText 
      itm.innerText = IIf(i = RW_START, "", SPLITTER) '<<< 
      i = i + 1 
     End If 
    Next 

    'get the remaining text and split on newline (<br>) 
    arr = Split(html_doc.body.innerText, SPLITTER) 
    i = RW_START 
    For Each itm In arr 
     itm = Trim(itm) 
     'remove trailing vbLf 
     If Right(itm, 1) = vblf Then itm = Left(itm, Len(itm)-1) 
     Cells(i, 3).Value = Trim(itm) 
     i = i + 1 
    Next 

End Sub