0

我正在尝试自动导入在 excel 中形成数据透视表的 xml 数据。要导入数据，从一张纸读取/复制链接，并将结果报告在另一张纸上。这种方法的唯一问题是我手动执行此操作。

这个宏怎么能

Sub retrieveXML2()
'
' pivotdataImport Macro
'

'
    Selection.Copy
    Sheets("data").Select
    ActiveWorkbook.XMLIMport url:= _
        "http://api.sba.gov/license_permit/all_by_state/al.xml", ImportMap:=Nothing, _
        Overwrite:=True, Destination:=Range("$A$2")
    Rows("2:2").Select
    Selection.EntireRow.Hidden = True
    Range("A4").Select
    Selection.End(xlDown).Select
    Range("A29").Select
    Sheets("url").Select
    Range("A3").Select
    Selection.Copy
    Sheets("data").Select
    ActiveWorkbook.XMLIMport url:= _
        "http://api.sba.gov/license_permit/all_by_state/ak.xml", ImportMap:=Nothing, _
        Overwrite:=True, Destination:=Range("$A$29")
    Rows("29:29").Select
    Selection.EntireRow.Hidden = True
    Range("Table2[[#Headers],[count]]").Select
    Selection.End(xlDown).Select
    Range("A59").Select
    Sheets("url").Select
    Range("A4").Select
    Selection.Copy
    Sheets("data").Select
    ActiveWorkbook.XMLIMport url:= _
        "http://api.sba.gov/license_permit/all_by_state/az.xml", ImportMap:=Nothing, _
        Overwrite:=True, Destination:=Range("$A$59")
    Rows("59:59").Select
    Selection.EntireRow.Hidden = True
    Range("A60").Select
    Selection.End(xlDown).Select
    Range("A85").Select
    Sheets("url").Select
    Range("A5").Select
    Selection.Copy
    Sheets("data").Select
    ActiveWorkbook.XMLIMport url:= _
        "http://api.sba.gov/license_permit/all_by_state/ar.xml", ImportMap:=Nothing, _
        Overwrite:=True, Destination:=Range("$A$85")
    Rows("85:85").Select
    Selection.EntireRow.Hidden = True
    Range("A86").Select
    Selection.End(xlDown).Select
    Range("A114").Select
    Sheets("url").Select
    Range("A6").Select
    Selection.Copy
    Sheets("data").Select
    ActiveWorkbook.XMLIMport url:= _
        "http://api.sba.gov/license_permit/all_by_state/ca.xml", ImportMap:=Nothing, _
        Overwrite:=True, Destination:=Range("$A$114")
    Rows("114:114").Select
    Selection.EntireRow.Hidden = True
    Range("A115").Select
    Selection.End(xlDown).Select
    Range("A141").Select
End Sub

是否只需对任意数量的 url 执行这些步骤，而无需将它们实际放置在需要的位置？

我的另一个宏

Public Sub retrieveXML()

  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlManual


    Dim lngRow As Long
    Dim strXML As String
    Dim ct As Integer, XMLMap

    Const maxXMLDel = 1
    lngRow = 2

    Do While Cells(lngRow, 1) <> ""
        strXML = Cells(lngRow, 1)
        ActiveWorkbook.XMLIMport url:=strXML, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$B$" & lngRow)
        lngRow = lngRow + 1
        For Each XMLMap In ActiveWorkbook.XmlMaps
                  XMLMap.Delete
        Next
      Loop

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlAutomatic

End Sub

做类似的事情；然而，它是为只能填充一行的 xml 数据设计的。因此，如果我尝试应用于形成数据透视表的 xml 数据，当它转到下一个 url 时，我会被告知数据已经存在于单元格中。那么如何使第二个宏执行录制的宏的操作呢？

我不知道桌子的长度，但需要它放在前一张桌子的下面。

4

1 回答 1

0

在工作簿的某处创建包含 url 和目标范围的列表，例如在 A 和 B 列的工作表“数据链接”中。

Dim rInput As Range

Set rInput = Sheets("datalinks").Range("A2:B2") 
Do While not IsEmpty(rInput)

    '.... YOUR CODE

    ActiveWorkbook.XMLIMport url:= rInput.Cells(1,1).Value2 _ 
        , ImportMap:=Nothing, _
        Overwrite:=True, Destination:=Range(rInput.Cells(1,2).Value2)

    '.... YOUR CODE

    Set rInput = rInput.Offset(1,0)
Loop
于 2013-03-26T13:20:23.567 回答