修改Excel VBA宏实现批量查询ABN网站提取实体类型并循环填充

我来帮你搞定这个需求——批量用B列的ABN查询网站，把对应「entity type」提取到C列对吧？下面是调整后的完整宏代码，还有详细的使用说明：

改进后的完整宏代码 #

Sub Batch_Get_Entity_Type()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim currentRow As Long
    Dim abnValue As String
    Dim qt As QueryTable
    Dim targetRange As Range
    Dim entityRow As Range
    Dim cell As Range
    
    ' 设置操作的工作表（可改成指定表名，比如Sheets("ABN查询表")）
    Set ws = ActiveSheet
    ' 获取B列最后一行有数据的行号
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 从第2行开始循环（假设第1行是表头）
    For currentRow = 2 To lastRow
        abnValue = ws.Cells(currentRow, "B").Value
        
        ' 如果当前ABN为空，直接跳过
        If abnValue = "" Then GoTo NextRow
        
        ' 先删除当前行可能存在的旧查询表，避免重复堆积
        For Each qt In ws.QueryTables
            If qt.Destination.Row = currentRow And qt.Destination.Column = 1 Then
                qt.Delete
            End If
        Next qt
        
        ' 创建临时查询表，把网站数据先拉到当前行A列（后续会清理）
        Set targetRange = ws.Cells(currentRow, "A")
        Set qt = ws.QueryTables.Add( _
            Connection:="URL;http://www.abr.business.gov.au/SearchByABN.aspx?SearchText=" & abnValue & "&safe=active", _
            Destination:=targetRange)
        
        ' 配置查询参数，确保数据加载完成再处理
        With qt
            .BackgroundQuery = False
            .TablesOnlyFromHTML = True
            .RefreshStyle = xlOverwriteCells
            .Refresh
            .SaveData = False
        End With
        
        ' 查找包含「Entity type」的行（忽略大小写适配网站文本）
        Set entityRow = Nothing
        For Each cell In targetRange.CurrentRegion.Rows
            If InStr(1, cell.Cells(1).Value, "Entity type", vbTextCompare) > 0 Then
                Set entityRow = cell
                Exit For
            End If
        Next cell
        
        ' 把提取到的实体类型写入C列对应单元格
        If Not entityRow Is Nothing Then
            ws.Cells(currentRow, "C").Value = entityRow.Cells(2).Value ' 假设类型在该行第2个单元格，可按需调整
        Else
            ws.Cells(currentRow, "C").Value = "未找到实体类型"
        End If
        
        ' 清理临时查询表和数据，避免污染表格
        qt.Delete
        targetRange.CurrentRegion.ClearContents
        
NextRow:
    Next currentRow
    
    MsgBox "批量查询完成！"
End Sub

代码关键部分说明 #

• 批量循环处理：通过lastRow获取B列最后一行数据，用For循环遍历每一个ABN，自动完成B2→C2、B3→C3的批量操作。
• 精准提取目标行：不再需要整表导入后删列，直接遍历查询返回的HTML表格，用InStr模糊匹配包含「Entity type」的行，提取对应内容。
• 避免冗余数据：每次查询后自动删除临时查询表和A列的临时数据，保持表格整洁。
• 容错处理：遇到空ABN或未找到数据的情况，会在C列标注提示，避免程序中断。

注意事项 #

• 网站结构适配：如果网站的HTML结构有变化（比如「Entity type」的文本或位置改变），需要调整InStr里的关键词，或者修改entityRow.Cells(2)的列号（比如改成Cells(3)）。
• 宏权限设置：需要在Excel中启用宏（文件→选项→信任中心→信任中心设置→宏设置→启用所有宏，或添加信任位置）。
• 访问速率控制：批量查询时建议加个延迟（比如在循环里加Application.Wait Now + TimeValue("00:00:01")），避免被网站限制访问。

内容的提问来源于stack exchange，提问作者Hidee