Excel调用JIRA API分页拉取数据时无响应及代码优化咨询

现有一段通过分页调用JIRA REST API拉取项目Bug数据的VBA代码，拉取1000条数据耗时约16分钟，运行期间Excel无响应。已尝试关闭Application.ScreenUpdating（耗时从18分钟缩至16分钟）、将批量大小从50调整为100，需解决无响应问题并获取更多优化技巧。

一、解决Excel无响应问题 #

• 添加DoEvents释放控制权：在循环批次处理的末尾插入DoEvents，让Excel能短暂处理UI事件，避免程序假死。
• 改用异步HTTP请求（进阶）：原代码用同步请求（http.Open "GET", url, False）会阻塞Excel直到请求完成。换成异步模式（True）并配合OnReadyStateChange事件处理，能让Excel在等待API响应时正常响应用户操作，但需要调整代码结构。

二、性能优化核心技巧 #

1. 批量写入数据，减少工作表交互：原代码逐行写入单元格是性能最大瓶颈之一。改用数组存储整批数据，最后一次性写入工作表，能大幅减少IO操作耗时。
2. 复用HTTP对象：原代码创建了两个HTTP对象，复用一个即可，避免重复创建销毁对象的额外开销。
3. 精简初始请求：初始请求仅需获取总条数，直接用maxResults=0，减少不必要的数据传输。
4. 关闭更多Excel后台功能：除了ScreenUpdating，还关闭EnableEvents、设置Calculation为手动，减少后台计算和事件触发的资源消耗。
5. 增大批量请求上限：JIRA API默认最大maxResults为100，部分实例支持调整到200，增大到API允许的最大值能减少请求次数。
6. 指定返回字段：通过fields参数只请求需要的字段（如id,key,status,priority,reporter,creator），缩小JSON数据体积，加快解析速度。

优化后的完整代码 #

Sub Jira_for_all_issues_optimized()
    Dim http As New MSXML2.XMLHTTP60, url As String, response As String
    Dim json As Object, startAt As Long, batchSize As Long, totalIssues As Long
    Dim issuesCount As Long, last_row_print As Long, i As Long
    Dim issues As Collection, StartTime As Double, SecondsElapsed As Double
    Dim user_name_password_in_base64_encoding As String
    Dim dataArr() As Variant ' 用于批量存储数据的数组
    
    StartTime = Timer
    user_name_password_in_base64_encoding = UserPassBase64()
    
    ' 关闭Excel后台消耗功能
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    ' 初始化表头并清空旧数据
    With Worksheets("Sheet2")
        .Cells(1, 1).Value = "Issue id"
        .Cells(1, 2).Value = "Issue key"
        .Cells(1, 3).Value = "Status"
        .Cells(1, 4).Value = "priority"
        .Cells(1, 5).Value = "reporter"
        .Cells(1, 6).Value = "reporter Id"
        .Cells(1, 7).Value = "creator Id"
        .Cells(1, 8).Value = "creator"
        .UsedRange.Offset(1).Clear
    End With
    
    ' 初始请求获取总Bug数（仅返回统计信息，无数据）
    url = "https://jira/rest/api/2/search?jql=project=project AND issuetype in (Bug)&maxResults=0&startAt=0"
    With http
        .Open "GET", url, False
        .setRequestHeader "Content-Type", "application/json"
        .setRequestHeader "Accept", "application/json"
        .setRequestHeader "Authorization", "Basic " & user_name_password_in_base64_encoding
        .send
    End With
    Set json = JsonConverter.ParseJson(http.responseText)
    totalIssues = json("total")
    
    startAt = 0
    batchSize = 200 ' 按API允许的最大值调整，默认100
    last_row_print = 2 ' 表头后起始行
    
    Do While startAt < totalIssues
        ' 构造请求URL，指定仅返回需要的字段
        url = "https://jira/rest/api/2/search?jql=project=project AND issuetype in (Bug)" & _
              "&maxResults=" & batchSize & "&startAt=" & startAt & _
              "&fields=id,key,status,priority,reporter,creator"
        
        With http
            .Open "GET", url, False
            .setRequestHeader "Content-Type", "application/json"
            .setRequestHeader "Authorization", "Basic " & user_name_password_in_base64_encoding
            .send
        End With
        response = http.responseText
        Set json = JsonConverter.ParseJson(response)
        Set issues = json("issues")
        issuesCount = issues.Count
        
        ' 初始化数组，适配当前批次数据量
        ReDim dataArr(1 To issuesCount, 1 To 8)
        
        ' 填充数组
        For i = 1 To issuesCount
            dataArr(i, 1) = issues(i)("id")
            dataArr(i, 2) = issues(i)("key")
            dataArr(i, 3) = issues(i)("fields")("status")("name")
            dataArr(i, 4) = issues(i)("fields")("priority")("name")
            dataArr(i, 5) = issues(i)("fields")("reporter")("displayName")
            dataArr(i, 6) = issues(i)("fields")("reporter")("name")
            dataArr(i, 7) = issues(i)("fields")("creator")("name")
            dataArr(i, 8) = issues(i)("fields")("creator")("displayName")
        Next i
        
        ' 一次性写入工作表，大幅提升效率
        Worksheets("Sheet2").Cells(last_row_print, 1).Resize(issuesCount, 8).Value = dataArr
        
        ' 更新行号和分页起始位置
        last_row_print = last_row_print + issuesCount
        startAt = startAt + batchSize
        
        ' 释放控制权，避免Excel假死
        DoEvents
    Loop
    
    ' 恢复Excel默认设置
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    SecondsElapsed = Round(Timer - StartTime, 2)
    MsgBox "所有Bug数据已拉取完成，耗时：" & SecondsElapsed & " 秒", vbInformation
End Sub

内容的提问来源于stack exchange，提问作者Aniruddh H S