web-scraping - 将单个网页表格编译成单个 Excel 可读表格

Question

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

如何将每个脊医的所有信息转换为单个电子表格行格式？

Answer 1

这很简单。在你的第一张纸上做Data > External data > From website. 粘贴 URL，选择主表并执行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 分钟调整并修复我犯的错误。