优化网页抓取与循环逻辑：修复分页遍历问题并精简VBA代码

Let's break down the issues in your current code and fix it to properly scrape each category URL for all its assigned pages, while cleaning up redundant code.

Key Issues in Original Code #

• Incorrect Loop Order: You're looping through pages first, then URLs—this means every URL gets scraped for every page number in your dataset, not just its own assigned page count from column D.
• Keyword Conflict: Using Rows as a variable name is bad practice since it's a reserved VBA keyword.
• Unnecessary Worksheet Selection: REZULTSheet.Select can lead to errors and is unnecessary; always reference sheets directly.
• Redundant HTTP Setup: The HTTP object configuration is repeated inside loops when it only needs to be set once.
• Uninitialized Variable: x isn't initialized to 1 at the start, which might cause data to be appended incorrectly if the macro runs multiple times.

Corrected & Streamlined Code #

Sub get_data()
    Dim wsURLs As Worksheet, wsProducts As Worksheet
    Dim lastRow As Long, x As Long, urlIndex As Long, pageNum As Integer
    Dim http As New XMLHTTP60, html As New HTMLDocument
    Dim baseURL As String, maxPages As Integer
    Dim topic As HTMLHtmlElement
    
    ' Set worksheet references (avoid Select)
    Set wsURLs = ThisWorkbook.Sheets("URLs_2")
    Set wsProducts = ThisWorkbook.Sheets("Products")
    
    ' Initialize row counter for results
    x = 1
    ' Turn off screen updating once at the start
    Application.ScreenUpdating = False
    
    ' Get last row of URLs in column A
    lastRow = wsURLs.Cells(wsURLs.Rows.Count, "A").End(xlUp).Row
    
    ' Loop through each URL in column A
    For urlIndex = 1 To lastRow
        baseURL = wsURLs.Cells(urlIndex, "A").Value
        maxPages = wsURLs.Cells(urlIndex, "D").Value
        
        ' Skip if URL is empty or page count is invalid
        If baseURL = "" Or maxPages < 1 Then GoTo NextURL
        
        ' Loop through each page for this URL
        For pageNum = 1 To maxPages
            With http
                .Open "GET", baseURL & "?display=90&sortby=1&page=" & pageNum, False
                .setRequestHeader "User-Agent", "Mozilla/5.0"
                .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
                .send
                
                ' Wait for response
                Do: DoEvents: Loop Until .readyState = 4
                If .Status <> 200 Then
                    Debug.Print "Failed to load: " & baseURL & " | Page: " & pageNum
                    GoTo NextPage
                End If
                
                html.body.innerHTML = .responseText
            End With
            
            ' Extract product data
            For Each topic In html.getElementsByClassName("ui-product-card__info")
                ' Product Name
                With topic.getElementsByClassName("product-name")
                    If .Length > 0 Then
                        wsProducts.Cells(x, 2).Value = .Item(0).innerText
                    End If
                End With
                
                ' Price
                With topic.getElementsByClassName("price-section-inner")
                    If .Length > 0 Then
                        wsProducts.Cells(x, 3).Value = .Item(0).innerText
                    End If
                End With
                
                ' Made In (uncomment if you want to use this)
                'With topic.getElementsByClassName("madein__text")
                '    If .Length > 1 Then
                '        wsProducts.Cells(x, 1).Value = .Item(1).innerText
                '    End If
                'End With
                
                x = x + 1 ' Move to next result row
            Next topic
            
NextPage:
        Next pageNum
        
NextURL:
    Next urlIndex
    
    ' Cleanup and restore settings
    Application.ScreenUpdating = True
    Set http = Nothing
    Set html = Nothing
    MsgBox "Scraping completed successfully!", vbInformation
End Sub

Key Improvements Explained #

1. Proper Loop Structure: First iterate over each URL, then loop through its specific page count from column D—this ensures each category only gets scraped for its intended number of pages.
2. Direct Worksheet References: No more Select; all cell writes explicitly reference wsProducts to avoid confusion.
3. Error Handling for HTTP Requests: Checks if the HTTP response status is 200 (success) and logs failures to the Immediate Window.
4. Initialization & Cleanup:
   • x starts at 1 to ensure results always begin at the top of the Products sheet.
   • Application.ScreenUpdating is turned off once at the start and restored at the end for better performance.
   • Cleans up HTTP/HTML objects to free memory.
5. Skip Invalid Entries: Skips rows where the URL is empty or the page count is less than 1 to avoid errors.
6. Reduced Redundancy: HTTP configuration is reused efficiently within loops without repeating unnecessary setup.

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