Excel_Vba 沪深股市，资产负债表下载

Sub 资产负债表()
    Cells.Clear
    Columns("A:A").NumberFormatLocal = "@"
    On Error Resume Next
    Set d = CreateObject("Scripting.Dictionary")
    Set hf = CreateObject("htmlfile")
    brr1 = Array("代码", "股票名称", "科目", "保户储金及投资款", "保户质押贷款", "拆出资金", "拆入资金", "持有至到期投资", "存出保证金", "存出资本保证金", "存放中央银行款项", "存货", "代理承销证券款", "代理买卖证券款", _
                 "代理业务负债", "代理业务资产", "递延所得税负债", "递延所得税资产", "定期存款", "独立帐户负债", "独立帐户资产", "短期借款", "发放贷款及垫款", "非流动负债合计", "非流动资产合计", "非正常经营项目收益调整", "负债合计", "负债和所有者(或股东权益)合计", _
                 "负债和所有者权益（或股东权益）总计", "工程物资", "固定资产", "固定资产清理", "贵金属", "货币资金", "减：库存股", "减:库存股", "交易性金融负债", "交易性金融资产", "结算备付金", "开发支出", "可供出售金融资产", "流动负债合计", "流动资产合计", "买入返售金融资产", _
                 "卖出回购金融资产款", "其他非流动负债", "其他非流动资产", "其他负债", "其他流动负债", "其他流动资产", "其他应付款", "其他应收款", "其他资产", "其中：交易席位费", "其中：客户备付金", "其中：客户资金存款", "其中:消耗性生物资产", "其中：质押借款", "商誉", _
                 "少数股东权益", "生产性生物资产", "实收资本（或股本）", "实收资本(或股本)", "寿险责任准备金", "所有者权益（或股东权益）合计", "所有者权益(或股东权益)合计", "同业及其他金融机构存放款项", "投资性房地产", _
                 "外币报表折算差额", "外币报表折算价差", "未到期责任准备金", "未分配利润", "未决赔款准备金", "无形资产", "吸收存款", _
                 "现金及存放同业款项", "向中央银行借款", "衍生金融负债", "衍生金融资产", "一般风险准备", "一年内到期的非流动负债", "一年内到期的非流动资产", "盈余公积", "应付保单红利", "应付分保帐款", "应付股利", _
                 "应付关联公司款", "应付利息", "应付赔付款", "应付票据", "应付手续费及佣金", "应付债券", "应付帐款", "应付账款", "应付职工薪酬", "应交税费", "应收保费", "应收代位追偿款", "应收分保寿险责任准备金", _
                 "应收分保未到期责任准备金", "应收分保未决赔款准备金", "应收分保长期健康险责任准备金", "应收分保帐款", "应收股利", "应收关联公司款", "应收款项", "应收利息", "应收票据", "应收账款", "油气资产", "预付款项", _
                 "预计负债", "预收保费", "预收款项", "在建工程", "长期待摊费用", "长期股权投资", "长期健康险责任准备金", "长期借款", "长期应付款", "长期应收款", "专项应付款", "资本公积", "资产总计")
    [a1:dt1] = brr1

    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "http://ddx.gubit.cn/js/stockCode.js", False
        .Send
        tt = StrConv(.responseBody, vbUnicode, &H804)
        With CreateObject("MSScriptControl.ScriptControl")
            .Language = "JScript"
            .AddCode tt
            n = .Eval("stockCodeArray.length")
            For i = 0 To n - 1
                Cells(i + 2, 1) = .Eval("stockCodeArray[" & i & "][0]")
                Cells(i + 2, 2) = .Eval("stockCodeArray[" & i & "][1]")
            Next i
        End With

        For p = 2 To n - 1
            s = Cells(p, 1)
            For i = 2 To UBound(brr1)
                d(brr1(i)) = " "
            Next i

            .Open "GET", "http://www.cninfo.com.cn/information/stock/balancesheet_.jsp?stockCode=" & s & "&yyyy=2014&mm=-12-31&cwzb=balancesheet&button2=提交", False
            .Send
            str1 = StrConv(.responseBody, vbUnicode, &H804)
            hf.body.innerHTML = str1
            Set r = hf.all.tags("table")(2).Rows

            For j = 0 To r.Length - 1
                w = Replace(r(j).Cells(0).innerText, " ", "")
                d(w) = r(j).Cells(1).innerText
                w = Replace(r(j).Cells(2).innerText, " ", "")
                d(w) = r(j).Cells(3).innerText
            Next j
            k = d.items
            Range(Cells(p, 3), Cells(p, 124)) = k
            d.RemoveAll
        Next p
    End With
End Sub

版权声明：本文为博主原创文章，未经博主允许不得转载。