过滤每个实例的特定元素
我设法从EDGAR DB中提取数据。 然而，我已经从所有实例文件中提取所有数据的代码。 无论我试图find一种方法，只从选定的实例元素中select元素文件，我找不到方法。 代码如下：
Sub READSITE() Dim IE As InternetExplorer Dim els, el, colDocLinks As New Collection Dim lnk, res Dim Ticker As String Dim colXMLPaths As New Collection Dim XMLElement As String Dim fillingType As String Set IE = New InternetExplorer IE.Visible = False Ticker = Worksheets("Sheet1").Range("A1").Value fillingType = Worksheets("Sheet3").Range("L1").Value LoadPage IE, "https://www.sec.gov/cgi-bin/browse-edgar?" & _ "action=getcompany&CIK=" & Ticker & "&type=" & fillingType & _ "&dateb=&owner=exclude&count=20" Set els = IE.Document.getelementsbytagname("a") For Each el In els If Trim(el.innertext) = "Documents" Then colDocLinks.Add el.href End If Next el For Each lnk In colDocLinks LoadPage IE, CStr(lnk) For Each el In IE.Document.getelementsbytagname("a") If el.href Like "*[0-9].xml" Then Debug.Print el.innertext, el.href colXMLPaths.Add el.href End If Next el Next lnk XMLElement = Range("C1").Value 'For each link, open the URL and display the Debt Instrument Insterest Rate For Each lnk In colXMLPaths res = GetData(CStr(lnk), XMLElement) With Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) .NumberFormat = "@" .Value = Ticker .Offset(0, 1).Value = lnk .Offset(0, 2).Value = res End With Next lnk End Sub Function GetData(sURL As String, sXMLElement As String) Dim strXMLSite As String Dim objXMLHTTP As New MSXML2.XMLHTTP Dim objXMLDoc As New MSXML2.DOMDocument Dim objXMLNodexbrl As MSXML2.IXMLDOMNode Dim objXMLNodeElement As MSXML2.IXMLDOMNode Dim objXMLNodeStkhldEq As MSXML2.IXMLDOMNode ''''''''''''''''''''' Dim userBeanList As MSXML2.IXMLDOMNodeList Dim userbean As MSXML2.IXMLDOMNode Dim beanChild As MSXML2.IXMLDOMNode Dim i As Long ''''''''''''''''''''' ' In Sheet 3 determine if Row 2 is free of data and set start row to 2. Else get the last free row in column b Sheets("Sheet3").Select Sheets("Sheet3").Range("B2").Select If ActiveCell.Value = "" Then i = 2 Else Sheets("Sheet3").Range("B1").Select Selection.End(xlDown).Select ActiveCell.Offset(1, -1).Range("A1").Select i = ActiveCell.Row End If 'Get tge XML from SEc GetData = "?" 'No data from XML objXMLHTTP.Open "GET", sURL, False '<<EDIT: GET the site objXMLHTTP.send objXMLDoc.LoadXML objXMLHTTP.responseText objXMLDoc.setProperty "SelectionNamespaces", "xmlns:r='http://www.xbrl.org/2003/instance'" Set objXMLNodexbrl = objXMLDoc.SelectSingleNode("r:xbrl") 'Get a single element value from the returned XML Set objXMLNodeElement = objXMLNodexbrl.SelectSingleNode(sXMLElement) If Not objXMLNodeElement Is Nothing Then GetData = objXMLNodeElement.Text End If 'Print all nodes name and value for each Element in the XML Set userBeanList = objXMLDoc.SelectNodes("r:xbrl") For Each userbean In userBeanList Worksheets("Sheet3").Cells(i, 1).Value = sURL For Each beanChild In userbean.ChildNodes With Worksheets("Sheet3") .Cells(i, 2).Value = beanChild.nodeName .Cells(i, 3).Value = beanChild.Text End With i = i + 1 Next beanChild Next userbean End Function Sub LoadPage(IE As Object, url As String) IE.Navigate url Do While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE DoEvents Loop End Sub 如何才能取代每个Instance文件的所有数据拉select每个实例文件说15个元素？
如果你正在寻找每个实例最多只能获得15个元素，那么给你的循环添加一个条件/添加一个if语句，在15次迭代之后将会跳出循环。 就像使用i = i + 1来控制要打印的行一样，使用新的variables（x，y无关紧要）来计算您通过beanChild循环运行的次数。 如果你需要实际的代码让我知道，但如果你已经完成了所有这些编码你看起来足够精通，以弄清楚:)
编辑：
好的，这里是我所得到的一个例子。 如果你想在每个源的15个元素最多可以做到这一点：
For Each userbean In userBeanList Worksheets("Sheet3").Cells(i, 1).Value = sURL x = 0 For Each beanChild In userbean.ChildNodes If x < 15 then With Worksheets("Sheet3") .Cells(i, 2).Value = beanChild.nodeName .Cells(i, 3).Value = beanChild.Text End With i = i + 1 x = x + 1 Next beanChild Else Exit For End If Next userbean