VBA ISBN查询代码优化：实现结果对应行单元格写入

原代码仅能将API返回结果写入固定单元格C1，要实现循环处理A1:A5的ISBN并将对应图书信息写入当前行，需按以下方式修改：

修改后完整代码 #

Sub FIND_ISBN()
    Dim jsonBooks As Object, auth, k
    Dim jsonBook As Object, bookDetails As Object
    Dim ws As Worksheet, isbn, rngIsbn As Range, cell As Range
    Dim currentRow As Long
    
    Set ws = ThisWorkbook.Worksheets("Books")
    Set rngIsbn = ws.Range("A1:A5")
    
    ' 写入表头（可选）
    ws.Cells(1, 2) = "标题"
    ws.Cells(1, 3) = "出版日期"
    ws.Cells(1, 4) = "作者"
    
    For Each cell In rngIsbn
        currentRow = cell.Row
        isbn = cell.Value
        ' 清空当前行原有内容
        ws.Range(ws.Cells(currentRow, 2), ws.Cells(currentRow, 4)).ClearContents
        
        If Len(isbn) > 5 Then
            Set jsonBooks = BookInfo(isbn)
            
            If Not jsonBooks Is Nothing Then
                If jsonBooks.Count = 0 Then
                    ws.Cells(currentRow, 2) = "无匹配结果"
                Else
                    For Each k In jsonBooks
                        Set jsonBook = jsonBooks(k)
                        Set bookDetails = jsonBook("details")
                        
                        ' 写入标题到当前行B列
                        ws.Cells(currentRow, 2) = bookDetails("title")
                        ' 写入出版日期到当前行C列
                        If bookDetails.Exists("publish_date") Then
                            ws.Cells(currentRow, 3) = bookDetails("publish_date")
                        Else
                            ws.Cells(currentRow, 3) = "无出版日期"
                        End If
                        ' 拼接所有作者并写入当前行D列
                        Dim authorStr As String
                        authorStr = ""
                        For Each auth In bookDetails("authors")
                            If authorStr <> "" Then authorStr = authorStr & ", "
                            authorStr = authorStr & auth("name")
                        Next auth
                        ws.Cells(currentRow, 4) = authorStr
                    Next k
                End If
            Else
                ws.Cells(currentRow, 2) = "API请求失败"
            End If
        Else
            ws.Cells(currentRow, 2) = "ISBN无效"
        End If
    Next cell
End Sub

Function BookInfo(isbn) As Object
    Dim url As String
    url = "https://openlibrary.org/api/books?bibkeys=ISBN:" & isbn & "&jscmd=details&format=json"
    Set BookInfo = responseObject(url)
End Function

Function responseObject(url As String) As Object
    Dim json As Object, http As Object
    Set http = CreateObject("msxml2.xmlhttp")
    
    On Error Resume Next
    With http
        .Open "GET", url, False
        .Send
        
        If .Status = 200 Then
            ' 确保已导入JsonConverter模块
            Set responseObject = JsonConverter.ParseJson(.responseText)
        Else
            Debug.Print "请求错误: " & .Status & " - " & .responseText
            Set responseObject = Nothing
        End If
    End With
    On Error GoTo 0
End Function

关键修改说明 #

• 恢复JSON解析：取消responseObject函数中JsonConverter.ParseJson的注释，删除硬编码写入C1的代码，改为返回解析后的JSON对象，实现结构化信息提取。
• 跟踪当前行号：用currentRow = cell.Row获取当前处理的ISBN所在行，所有写入操作均基于该行号，确保信息对应到目标行。
• 结构化写入字段：将标题、出版日期、作者分别写入当前行的B、C、D列，同时处理字段缺失的情况（如无出版日期），避免运行报错。
• 异常场景处理：针对ISBN无效、无匹配结果、API请求失败等情况，在对应行写入明确提示，提升可读性。

注意：使用前需确保已导入JsonConverter模块（VBA常用的JSON解析工具，直接导入模块即可使用）。

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