Question

我想为亚利桑那州的所有脊医创建一份主要的联系信息列表。董事会网站列出了所有脊椎治疗师here但是，我必须点击查看每个地址和电话号码。

如何以单个电子表格行格式获取有关每个脊椎治疗师的所有信息？

Answer 1

这很容易。在第一张表格中Data > External data > From website。粘贴网址，选择主表并执行Next并将其放入A1。

在VBA编辑器中粘贴以下公式并执行它。它将从网站检索所有数据并将其粘贴到Sheet2中。其余的只是重新组织不是你问题主题的数据，所以我把它留给你。

Sub ExtractAllData()
    Dim dest As Range, license As Range
    Dim license_no As String

    Worksheets("Feuil2").Select
    Set dest = Worksheets("Feuil2").Range("A1")
    Set license = Worksheets("Feuil1").Range("C3")
    Do Until license.Value = ""
        license_no = Mid(license.Value, 1, InStr(1, license.Value, " "))
        With Worksheets("Feuil2").QueryTables.Add(Connection:= _
            "URL;http://www.azchiroboard.us/ProDetail.asp?LicenseNo=" & license_no, Destination:= _
            dest)
            .Name = "ProDetail.asp?LicenseNo=" & license_no
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "1"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
        Set dest = Range("A65535").End(xlUp)
        Set dest = dest.Offset(1, 0)
        Set license = license.Offset(1, 0)
    Loop
End Sub

为了记录，我花了1分钟来弄清楚如何从主表中检索数据。 1分钟，以确定链接只是调用带有许可证号的PHP页面。 1分钟录制宏，然后5分钟调整它并修复我所犯的错误。

将单个网页表编译为单个Excel可读表

1 个答案: