Question

我正在尝试自动导入在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

只需对任意数量的网址执行这些步骤而不将其实际放置在需要的位置？

我的另一个宏

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数据，当它进入下一个数据库时，我会被告知数据已经存在于数据库中。那么第二个宏如何才能完成录制宏的动作呢？

我不知道表的长度，但需要将它放在上一个表的下方。

Answer 1

在工作簿中的某处创建包含网址和目标范围的列表，例如在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

使用VBA导入多个数据透视表

1 个答案: