Question

我在所有地方的Stack Exchange上都找到了一些代码，并且能够根据我的需要将其修改为95％，但最后一个问题不断出现，父DIV中的所有DIV都粘贴到一个单元格中，I希望他们发布到我的工作表中的单个单元格。代码来自Stack Overflow用户“Portland Runner”，可以找到原始帖子here。我反对的HTML看起来像这样：

{
  "rules": {
    "folder": {
//    users cannot delete items in the node folder
      ".write": "newData.exists()",
//    item is a variable
      "$item": {
        "dataset1": {
//        dataset1 must have certain nodes and can't be deleted (set to null)
          ".validate": "data.hasChildren(['data1', 'data2', 'data3']) && newData.exists()",
          "data1": {".validate": "newData.isNumber()"},
          "data2": {".validate": "newData.isNumber()"},
          "data3": {".validate": "newData.isNumber()"},
//        using the variable $other means any node that isn't data1, data2, data3 is denied
          "$other": {".validate": false}
        }
      }
    }
  }
}

子DIV没有ID，类或样式，只有被寂寞的DIV标记包围的信息。这一切都被转储到我想要的单个单元格中，而不是它被转储到Al（条目1），B1（条目2），C1（条目3）等。原始代码如下：

<div class="right-header">
 <div>Entry 1</div>
 <div>Entry 2</div>
 <div>Entry 3</div>
 <div>Entry 4</div>
 <div>Entry 5</div>
 <div>Entry 6</div>
</div>

感谢您的帮助！

Answer 1

已编译但未经过测试：

Sub extract()
Dim IE As InternetExplorer
Dim topDiv, div, childDivs, tc As String, cntr

    Set IE = New InternetExplorerMedium
    IE.Visible = False
    IE.Navigate2 "C:\Users\john\Documents\Test.html"

    ' Wait while IE loading
    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop

    Set topDiv = IE.document.getElementsByClassName("right-header")(0)

    Set childDivs = topDiv.getElementsByTagName("div")

    cntr = 2

    For Each div In childDivs
        tc = Trim(div.textContent)
        If tc <> "" Then
            Select Case Right(tc, 1)
                Case "<div>"
                    'not sure whether you should be seeing HTML in textcontent...?
                    Range("B" & cntr) = CStr(tc)
                Case "%"
                    Range("C" & cntr).Value = tc
                    cntr = cntr + 1
                Case 0
                    Range("C" & cntr).Value = tc
                Case Else
                    Range("A" & cntr).Value = tc
            End Select
        End If
    Next div

    Sheets("Sheet3").Range("A1").Value = topDiv.textContent

    'Cleanup
    IE.Quit
    Set IE = Nothing
End Sub

Excel VBA：通过DIV内容迭代 - 粘贴到单个单元格中

1 个答案: