如何用VBA循环批量抓取多个StockCharts行业代码的数据？

Got it, let's adjust your existing code to handle multiple sector codes and consolidate all results into a single Excel sheet. Here's the modified version with clear explanations of the key updates:

Modified VBA Code #

Sub Batch_StockCharts_By_Subsector()
    Dim HTMLDoc As New HTMLDocument
    Dim objTable As Object
    Dim lngRow As Long
    Dim lngTable As Long
    Dim lngCol As Long
    Dim ActRw As Long
    Dim objIE As InternetExplorer
    Dim sectorCodes As Variant
    Dim currentSector As Variant
    
    ' Add/remove sector codes here as needed
    sectorCodes = Array("DJUSHP", "DJUSOL", "DJUSOI", "DJUSPL")
    
    Set objIE = New InternetExplorer
    objIE.Visible = False ' Set to True if you want to see the browser during scraping
    
    ActRw = 0 ' Initialize starting row position
    
    ' Loop through each sector code in our list
    For Each currentSector In sectorCodes
        ' Build the URL for the current sector
        objIE.Navigate "https://stockcharts.com/freecharts/sectorsummary.html?&G=SECTOR_" & currentSector & "&O=1"
        
        ' Wait for the page to fully load
        Do Until objIE.ReadyState = 4 And Not objIE.Busy
            DoEvents
        Loop
        Application.Wait (Now + TimeValue("0:00:03")) ' Wait for JavaScript-rendered content
        
        HTMLDoc.body.innerHTML = objIE.Document.body.innerHTML
        
        ' Add a bold header for the current sector to keep data organized
        ActRw = ActRw + 1
        ThisWorkbook.Sheets("Sheet1").Cells(ActRw, 1).Value = "Sector: " & currentSector
        ThisWorkbook.Sheets("Sheet1").Cells(ActRw, 1).Font.Bold = True
        ActRw = ActRw + 1 ' Move down one row for the table data
        
        ' Extract and write table data to the sheet
        With HTMLDoc.body
            Set objTable = .getElementsByTagName("table")
            For lngTable = 0 To objTable.Length - 1
                For lngRow = 0 To objTable(lngTable).Rows.Length - 1
                    For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                        ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow, lngCol + 1) = _
                            objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
                    Next lngCol
                Next lngRow
                ActRw = ActRw + objTable(lngTable).Rows.Length + 1 ' Add space between tables
            Next lngTable
        End With
    Next currentSector
    
    ' Clean up resources
    objIE.Quit
    Set objIE = Nothing
    Set HTMLDoc = Nothing
    Set objTable = Nothing
    
    MsgBox "Batch scrape finished successfully!", vbInformation
End Sub

Key Updates Explained #

• Sector Code Array: We created an Array() to store all your target sector codes. You can easily add more codes or remove existing ones here without touching the core scraping logic.
• Loop Through Sectors: A For Each loop iterates over each code in the array, dynamically building the correct URL for each sector's summary page.
• Organized Headers: Bold section headers are added for each sector to make the consolidated data easy to read and distinguish between different sectors.
• Reusable IE Instance: Instead of opening and closing Internet Explorer for every sector, we reuse a single instance to speed up the scraping process.
• Proper Initialization: We set ActRw = 0 to ensure we start writing data from the top of the sheet every time the macro runs.
• Resource Cleanup: Explicitly release object references to avoid memory leaks after the macro finishes.

Quick Notes #

• Ensure you have Microsoft HTML Object Library and Microsoft Internet Controls enabled in your VBA editor (go to Tools > References to check these boxes).
• Adjust the Application.Wait duration if some pages take longer to load their JavaScript content.
• If you want to watch the scraping process, set objIE.Visible = True.

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