基于Excel VBA实现nepsealpha.com股票数据提取自动化需求

需求概述 #

• 自动访问https://www.nepsealpha.com/nepse-data，填入指定的起始日期、结束日期及股票代码（股票代码列表存储在Excel的独立工作表中）
• 批量提取所有股票的5年历史数据，汇总到单个Excel工作表
• 后续每日自动提取指定股票指数的最新数据，保存至单独工作表

核心问题解决 #

目标网页的输入框和提交按钮无ID/Name属性，需通过XPath或CSS选择器定位元素，替代原代码中FindElementById/FindElementByName的定位方式。

完整VBA实现代码 #

Sub NEPSEDataExtractor()
    Dim driver As New Selenium.ChromeDriver
    Dim wsStockList As Worksheet, wsHistory As Worksheet, wsDaily As Worksheet
    Dim lastRow As Long, i As Long
    Dim stockCode As String
    Dim startDate As String, endDate As String
    Dim dataTable As Selenium.WebElement
    Dim rowCount As Long, colCount As Long, r As Long, c As Long
    
    ' 初始化工作表（根据实际表名修改）
    Set wsStockList = ThisWorkbook.Worksheets("股票代码列表") ' 存储股票代码的工作表
    Set wsHistory = ThisWorkbook.Worksheets("历史数据汇总") ' 存储5年历史数据的工作表
    Set wsDaily = ThisWorkbook.Worksheets("每日指数数据") ' 存储每日数据的工作表
    
    ' 初始化浏览器
    driver.Start
    driver.Get "https://www.nepsealpha.com/nepse-data"
    driver.Wait 2000 ' 等待页面加载
    
    ' ---------------------- 批量提取5年历史数据 ----------------------
    ' 清空历史数据工作表（保留表头）
    wsHistory.Range("A2:Z" & wsHistory.Cells(wsHistory.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    ' 设置5年时间范围（示例：当前日期往前推5年）
    endDate = Format(Date, "yyyy-MM-dd")
    startDate = Format(DateAdd("yyyy", -5, Date), "yyyy-MM-dd")
    
    ' 获取股票代码列表的最后一行
    lastRow = wsStockList.Cells(wsStockList.Rows.Count, "A").End(xlUp).Row
    
    ' 循环遍历每个股票代码
    For i = 2 To lastRow ' 假设第1行是表头
        stockCode = wsStockList.Cells(i, "A").Value
        If stockCode <> "" Then
            On Error Resume Next ' 捕获单个股票提取失败的情况
            ' 定位股票代码输入框（通过XPath定位，需根据实际网页结构调整）
            driver.FindElementByXPath("//input[@placeholder='Stock Symbol']").Clear
            driver.FindElementByXPath("//input[@placeholder='Stock Symbol']").SendKeys stockCode
            
            ' 定位起始日期输入框
            driver.FindElementByXPath("//input[@placeholder='Start Date']").Clear
            driver.FindElementByXPath("//input[@placeholder='Start Date']").SendKeys startDate
            
            ' 定位结束日期输入框
            driver.FindElementByXPath("//input[@placeholder='End Date']").Clear
            driver.FindElementByXPath("//input[@placeholder='End Date']").SendKeys endDate
            
            ' 点击提交按钮（通过XPath定位按钮，需根据实际网页结构调整）
            driver.FindElementByXPath("//button[contains(text(), 'Submit')]").Click
            driver.Wait 3000 ' 等待数据加载
            
            ' 提取数据表格（假设数据在<table>标签内）
            Set dataTable = driver.FindElementByTag("table")
            rowCount = dataTable.FindElementsByTag("tr").Count
            colCount = dataTable.FindElementByTag("tr").FindElementsByTag("td").Count
            
            ' 将数据写入历史数据工作表（跳过表头，从下一行追加）
            For r = 2 To rowCount ' 第1行是表格表头，跳过
                For c = 1 To colCount
                    wsHistory.Cells(wsHistory.Cells(wsHistory.Rows.Count, "A").End(xlUp).Row + 1, c).Value = _
                    dataTable.FindElementsByTag("tr")(r - 1).FindElementsByTag("td")(c - 1).Text
                Next c
                ' 追加股票代码列（方便区分数据所属股票）
                wsHistory.Cells(wsHistory.Cells(wsHistory.Rows.Count, "A").End(xlUp).Row, colCount + 1).Value = stockCode
            Next r
            
            ' 回到数据查询页面，准备下一个股票
            driver.Get "https://www.nepsealpha.com/nepse-data"
            driver.Wait 2000
            On Error GoTo 0
        End If
    Next i
    
    ' ---------------------- 每日数据提取（可单独拆分或定时运行） ----------------------
    ' 清空每日数据工作表（保留表头）
    wsDaily.Range("A2:Z" & wsDaily.Cells(wsDaily.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    ' 设置每日数据的时间范围（当日）
    startDate = Format(Date, "yyyy-MM-dd")
    endDate = startDate
    
    ' 重新遍历股票代码列表提取当日数据
    For i = 2 To lastRow
        stockCode = wsStockList.Cells(i, "A").Value
        If stockCode <> "" Then
            On Error Resume Next
            driver.FindElementByXPath("//input[@placeholder='Stock Symbol']").Clear
            driver.FindElementByXPath("//input[@placeholder='Stock Symbol']").SendKeys stockCode
            
            driver.FindElementByXPath("//input[@placeholder='Start Date']").Clear
            driver.FindElementByXPath("//input[@placeholder='Start Date']").SendKeys startDate
            
            driver.FindElementByXPath("//input[@placeholder='End Date']").Clear
            driver.FindElementByXPath("//input[@placeholder='End Date']").SendKeys endDate
            
            driver.FindElementByXPath("//button[contains(text(), 'Submit')]").Click
            driver.Wait 2000
            
            Set dataTable = driver.FindElementByTag("table")
            rowCount = dataTable.FindElementsByTag("tr").Count
            
            ' 将当日数据写入每日工作表
            If rowCount > 1 Then ' 确保有数据
                For c = 1 To colCount
                    wsDaily.Cells(wsDaily.Cells(wsDaily.Rows.Count, "A").End(xlUp).Row + 1, c).Value = _
                    dataTable.FindElementsByTag("tr")(1).FindElementsByTag("td")(c - 1).Text ' 取第2行数据（当日数据）
                Next c
                wsDaily.Cells(wsDaily.Cells(wsDaily.Rows.Count, "A").End(xlUp).Row, colCount + 1).Value = stockCode
            End If
            
            driver.Get "https://www.nepsealpha.com/nepse-data"
            driver.Wait 2000
            On Error GoTo 0
        End If
    Next i
    
    ' 关闭浏览器
    driver.Quit
    Set driver = Nothing
    MsgBox "数据提取完成！"
End Sub

代码说明 #

1. 工作表配置：需提前创建三个工作表，分别存储股票代码列表、历史数据汇总、每日指数数据，修改代码中对应工作表名称以匹配实际文件。
2. 元素定位：代码中使用的XPath需根据网页实际结构调整，可通过浏览器开发者工具（F12）复制元素的XPath或CSS选择器。
3. 错误处理：加入On Error Resume Next避免单个股票提取失败导致整个程序终止，后续可扩展错误日志记录。
4. 数据追加：历史数据以追加方式写入，每日数据每次运行清空原有数据后写入最新数据。

注意事项 #

• 需提前安装Selenium VBA库，可通过VBA编辑器的「工具」→「引用」添加对应库。
• 网页结构若发生变化，需重新调整元素定位的XPath/CSS选择器。
• 可通过Windows任务计划程序配合Excel宏实现每日自动运行。

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