VBA获取API返回CSV数据写入单元格被截断，如何加载为Excel数据表

你的代码问题在于将完整CSV字符串直接赋值给单个单元格，既触发了Excel单单元格32767字符的容量限制，也没有完成CSV格式的结构化拆分。可以按以下方案调整代码：

修改后的完整代码 #

Sub MDM_API_CALL()
    Dim hReq As Object
    Dim ws As Worksheet
    Dim authKey As String
    Dim strUrl As String
    Dim response As String
    Dim lineArr As Variant
    Dim rowArr As Variant
    Dim i As Long, j As Long
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 清空原有数据
    ws.Cells.Clear
    
    ' 第一步：获取鉴权Token
    strUrl = "url to request bearer token"
    Set hReq = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    With hReq
        .Open "POST", strUrl, False
        .Send
    End With
    response = hReq.responseText
    authKey = Mid(response, 11, Len(Mid(response, 11, Len(response) - 12)))
    
    ' 第二步：请求CSV格式数据
    strUrl = "url that requests the data in CSV format"
    Set hReq = CreateObject("MSXML2.XMLHTTP")
    With hReq
        .Open "GET", strUrl, False
        .SetRequestHeader "Authorization", "Bearer " & authKey
        .Send
    End With
    response = hReq.responseText
    
    ' 第三步：拆分CSV写入单元格
    ' 按换行符拆分所有行
    lineArr = Split(response, vbLf)
    For i = LBound(lineArr) To UBound(lineArr)
        ' 跳过空行
        If Trim(lineArr(i)) <> "" Then
            ' 按逗号拆分当前行的每一列
            rowArr = Split(Trim(lineArr(i)), ",")
            ' 写入当前行对应单元格，行号从1开始
            For j = LBound(rowArr) To UBound(rowArr)
                ws.Cells(i + 1, j + 1).Value = rowArr(j)
            Next j
        End If
    Next i
    
    ' 可选：自动调整列宽
    ws.UsedRange.EntireColumn.AutoFit
End Sub

优化说明 #

• 如果你的CSV字段内容本身包含逗号（比如带逗号的文本字段），可以替换拆分逻辑，改用Excel内置的文本分列功能，处理更稳妥：

' 替换第三步拆分逻辑的代码
ws.Range("A1").Value = response
ws.Range("A1").TextToColumns _
    Destination:=ws.Range("A1"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    Comma:=True

• 数据量超过10万行的场景下，建议先将返回的CSV写入临时文件，再用Workbooks.Open打开临时文件复制数据，效率会比逐行写入高很多。

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