VBA过程输出不同数量的字符串变量以进行声明和重用

时间:2014-02-19 20:16:44

标签: string excel vba excel-vba

此处我们有Codo提供给Mr Tim Williams的程序,该程序打印在Immediate window我们真正想要的东西上。我从original copy进行了一些小修改,我旁边有评论词MODIFICATION

Sub MAGAZINE()

    Dim IE As InternetExplorer ' MODIFICATION
    Dim els, el, colDocLinks As New Collection
    Dim lnk
    Dim Ticker As String ' MODIFICATION

    Set IE = New InternetExplorer 'MODIFICATION

    IE.Visible = True

    Ticker = Worksheets("Sheet1").Range("A1").Value 'MODIFICATION

    loadpage IE, "https://www.sec.gov/cgi-bin/browse-edgar?" & _
                  "action=getcompany&CIK=" & Ticker & "&type=10-Q" & _   'MODIFICATION by putting the Ticker String Variable and then Concatenate accordingly
                  "&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                'MODIFICATION
                Debug.Print el.innertext, el.href
            End If
        Next el
    Next lnk

End Sub

Sub loadpage(IE As Object, url As String)
    IE.Navigate url
    Do While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
End Sub

您可以在第四次修改/添加中注意到,一个人只需在单元格A1上键入股票代码并触发代码

Ticker = Worksheets("Sheet1").Range("A1").Value 'MODIFICATION

现在的问题是,如果我们使用不同的股票代码,我们会在立即窗口上打印不同的行数。

例如,通过在单元格A1中键入股票代码CRR,我们得到11个结果

CRR

现在,如果我们在单元格A1中键入自动收录机MSFT,我们得到14个结果

MSFT

现在问题的关键是这些字符串值需要插入到RIFLE macro中,虽然我可以确定我从字符串变量中的每个循环迭代得到的值,但是在我的脑海里抛出一个猴子扳手是MAGAZINE macro因为逻辑没有在即时窗口上打印确切的行数。您可以看到实际上在前两张图片中......


那么当MAGAZINE macro的结果为6行时怎么可能呢?这些被分配给6个字符串变量并且没有30个字符串变量总是被声明在内存中破坏并且结果是14行;这些将分配给14个字符串变量。

如何在运行时调整这一点,以便步枪总是加载正确的轮数?

因为我不会止步于此;那么我计划在user2140261提供的RIFLE macro中插入这些字符串变量,如下所示......

Sub RIFLE()
Dim strXMLSite As String
Dim objXMLHTTP As MSXML2.XMLHTTP
Dim objXMLDoc As MSXML2.DOMDocument
Dim objXMLNodexbrl As MSXML2.IXMLDOMNode
Dim objXMLNodeDIIRSP As MSXML2.IXMLDOMNode

Set objXMLHTTP = New MSXML2.XMLHTTP
Set objXMLDoc = New MSXML2.DOMDocument

strXMLSite = "http://www.sec.gov/Archives/edgar/data/10795/000119312513456802/bdx-20130930.xml"

objXMLHTTP.Open "POST", strXMLSite, False
objXMLHTTP.send
objXMLDoc.LoadXML (objXMLHTTP.responseText)

Set objXMLNodexbrl = objXMLDoc.SelectSingleNode("xbrl")

Set objXMLNodeDIIRSP = objXMLNodexbrl.SelectSingleNode("us-gaap:DebtInstrumentInterestRateStatedPercentage")

Worksheets("Sheet1").Range("A1").Value = objXMLNodeDIIRSP.Text
End Sub

如果你可以将来自MAGAZINE宏的波动数量的字符串值插入到RIFLE宏中的字符串变量中,这将会影响整个问题。

此处的RIFLE宏具有strXMLSite String Variabe的原始格式。

UPDATE 我目前正在尝试将其加载到数组中,然后将其卸载...

1 个答案:

答案 0 :(得分:2)

这是一个建议:

Sub MAGAZINE()

    Dim IE As InternetExplorer ' MODIFICATION
    Dim els, el, colDocLinks As New Collection
    Dim lnk, res
    Dim Ticker As String ' MODIFICATION
    Dim colXMLPaths As New Collection '<<<EDIT

    Set IE = New InternetExplorer 'MODIFICATION

    IE.Visible = True

    Ticker = Worksheets("Sheet1").Range("A1").Value 'MODIFICATION

    LoadPage IE, "https://www.sec.gov/cgi-bin/browse-edgar?" & _
                  "action=getcompany&CIK=" & Ticker & "&type=10-Q" & _
                  "&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  '<<<EDIT
            End If
        Next el
    Next lnk

    'EDIT: ADDED
    For Each lnk In colXMLPaths
        res = RIFLE(CStr(lnk))
        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 RIFLE(sURL As String)
    Dim strXMLSite As String
    Dim objXMLHTTP As New MSXML2.XMLHTTP
    Dim objXMLDoc As New MSXML2.DOMDocument
    Dim objXMLNodexbrl As MSXML2.IXMLDOMNode
    Dim objXMLNodeDIIRSP As MSXML2.IXMLDOMNode

    RIFLE = "???"
    objXMLHTTP.Open "GET", sURL, False  '<<EDIT: GET not POST
    objXMLHTTP.send
    objXMLDoc.LoadXML (objXMLHTTP.responseText)

    Set objXMLNodexbrl = objXMLDoc.SelectSingleNode("xbrl")

    Set objXMLNodeDIIRSP = objXMLNodexbrl.SelectSingleNode _
            ("us-gaap:DebtInstrumentInterestRateStatedPercentage")

    If Not objXMLNodeDIIRSP Is Nothing Then
        RIFLE = objXMLNodeDIIRSP.Text
    End If
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