VBA网页抓取故障：无法正确获取存储单元数据（含重复/缺失字段）

我帮你梳理了代码里的几个核心问题，导致重复数据、字段抓取失败的原因都在这里，还有修正后的完整代码：

原代码的关键问题 #

1. 重复数据根源：你在循环每个item（单元行）时，所有字段都是从listing（整个表格）的第一个匹配元素取（比如listing.getElementsByClassName("size...")(0)），而不是从当前item里找对应元素，所以不管循环多少行，都是重复第一条单元的数据。
2. 遗漏单元行：只遍历了unitinfo even类的行，漏掉了unitinfo odd的单元，导致抓取数量不全。
3. 设施（Amenities）抓取错误：直接取.amenities的innerText会拿到无格式的列表，而且没有从当前单元行里定位；另外网页里设施是嵌套在li标签里的，需要拼接每个设施的文本才会显示清晰。
4. 预订（Reserve）字段定位错误：同样没有从当前单元行找按钮，而且没有处理按钮不存在的情况。
5. 行数量计算错误：用.tab_container li的长度作为行数，这个元素和单元数量无关，应该直接统计所有.unitinfo的数量。
6. 缺乏错误处理：当某个单元没有优惠（offer1不存在）时，代码会直接报错中断。

修正后的完整代码 #

Sub ScrapeStorageUnits()
    Dim ie As New InternetExplorer, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Unit Data")
    
    With ie
        .Visible = True
        .Navigate2 "https://www.safeandsecureselfstorage.com/self-storage-lake-villa-il-86955"
        ' 等待页面完全加载（包括动态内容）
        While .Busy Or .readyState < 4: DoEvents: Wend
        ' 额外等待1秒确保动态渲染完成
        Application.Wait Now + TimeValue("00:00:01")
        
        Dim headers() As Variant, results() As Variant
        Dim allUnits As Object, unitRow As Object
        Dim r As Long, amenitiesList As Object, amenityItem As Object
        Dim amenitiesText As String
        
        ' 定义表头
        headers = Array("Size", "Amenities", "Specials", "Price", "Reserve Link")
        ' 获取所有单元行（包括even和odd类）
        Set allUnits = .document.querySelectorAll(".unitinfo")
        
        ' 初始化结果数组
        ReDim results(1 To allUnits.Length, 1 To UBound(headers) + 1)
        
        r = 0
        For Each unitRow In allUnits
            r = r + 1
            ' 1. 抓取尺寸：从当前单元行找size元素
            If unitRow.querySelectorAll(".size.secondary-color-text").Length > 0 Then
                results(r, 1) = unitRow.querySelector(".size.secondary-color-text").innerText
            End If
            
            ' 2. 抓取设施：拼接所有li的文本
            amenitiesText = ""
            Set amenitiesList = unitRow.querySelectorAll(".amenities li")
            If amenitiesList.Length > 0 Then
                For Each amenityItem In amenitiesList
                    amenitiesText = amenitiesText & amenityItem.innerText & ", "
                Next
                ' 去掉最后一个逗号空格
                results(r, 2) = Left(amenitiesText, Len(amenitiesText) - 2)
            End If
            
            ' 3. 抓取优惠：处理无优惠的情况
            If unitRow.querySelectorAll(".offer1").Length > 0 Then
                results(r, 3) = unitRow.querySelector(".offer1").innerText
            Else
                results(r, 3) = "No Specials"
            End If
            
            ' 4. 抓取价格
            If unitRow.querySelectorAll(".rate_text.primary-color-text.rate_text--clear").Length > 0 Then
                results(r, 4) = unitRow.querySelector(".rate_text.primary-color-text.rate_text--clear").innerText
            End If
            
            ' 5. 抓取预订链接：获取按钮的href属性，要文本的话改成.innerText即可
            If unitRow.querySelectorAll(".reserve").Length > 0 Then
                results(r, 5) = unitRow.querySelector(".reserve").href
            Else
                results(r, 5) = "No Reserve Option"
            End If
        Next unitRow
        
        ' 写入表头和结果
        ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
        
        ' 自动调整列宽
        ws.Range("A:E").Columns.AutoFit
        
        .Quit
    End With
    
    Set ie = Nothing
    MsgBox "数据抓取完成！", vbInformation
End Sub

主要修改说明 #

• 改用querySelectorAll定位元素：比getElementsByClassName更精准，支持复合选择器，定位元素更可靠。
• 从当前单元行（unitRow）取数据：确保每一行对应单个单元的信息，彻底解决重复数据问题。
• 遍历所有.unitinfo行：不再区分even/odd类，抓取页面上的全部存储单元。
• 设施文本拼接：把每个设施项的文本拼接成逗号分隔的字符串，显示格式更清晰易读。
• 增加错误处理：每个字段都先判断元素是否存在，避免程序报错中断，同时给无数据的字段填充友好的默认值。
• 预订字段优化：默认抓取预订按钮的链接，如果需要按钮文本，把.href改成.innerText即可。
• 增加等待时间：确保页面动态加载完成，避免因元素未渲染导致的抓取失败。

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