Excel 2016无需流操作能否导出UTF-8编码工作表？宏处理JSON遇阻

嘿，我帮你整理了一套能解决这个问题的完整VBA宏方案，应该能搞定你遇到的JSON格式问题——毕竟手动处理JSON嵌套和文件操作确实容易踩坑。

核心流程拆解 #

• 用专业JSON解析工具导入JSON到工作表，避免手动解析格式出错
• 基于你设置的「旧值」「新值」列批量替换内容
• 自动备份原JSON文件（加时间戳后缀），防止数据丢失
• 将处理后的工作表数据转回标准JSON格式，导出为原文件名

第一步：准备JSON解析工具 #

你需要先在VBA工程中添加VBA-JSON模块：

1. 打开VBA编辑器，插入一个新的标准模块
2. 把VBA-JSON的核心代码复制进去（这个是VBA生态里处理JSON的常用工具，能完美处理嵌套结构）

第二步：完整宏代码实现 #

Sub UpdateJSONWithReplacements()
    Dim jsonPath As String
    Dim wsReplace As Worksheet, wsJSON As Worksheet
    Dim fso As Object
    Dim jsonText As String
    Dim jsonObj As Object
    Dim i As Long
    Dim oldVal As String, newVal As String
    
    ' 👇 这里改成你自己的工作表名称和JSON文件路径
    Set wsReplace = ThisWorkbook.Sheets("替换规则") ' 存放「旧值」「新值」的工作表
    Set wsJSON = ThisWorkbook.Sheets("JSON数据") ' 临时存放JSON内容的工作表
    jsonPath = "C:\Your\Target\File\data.json" ' 你的JSON文件路径
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 1. 读取并解析JSON到工作表
    Open jsonPath For Input As #1
    jsonText = Input$(LOF(1), 1)
    Close #1
    
    Set jsonObj = JsonConverter.ParseJson(jsonText)
    wsJSON.Cells.Clear ' 清空工作表旧数据
    WriteJSONToSheet jsonObj, wsJSON.Range("A1") ' 递归写入JSON层级
    
    ' 2. 批量替换字符串
    For i = 2 To wsReplace.Cells(wsReplace.Rows.Count, "A").End(xlUp).Row
        oldVal = wsReplace.Cells(i, "A").Value
        newVal = wsReplace.Cells(i, "B").Value
        
        If oldVal <> "" Then
            ' 遍历所有单元格替换，支持模糊匹配
            wsJSON.Cells.Replace What:=oldVal, Replacement:=newVal, LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False
        End If
    Next i
    
    ' 3. 备份原JSON文件
    Dim backupPath As String
    backupPath = Left(jsonPath, Len(jsonPath) - 5) & "_backup_" & Format(Now(), "YYYYMMDDHHMMSS") & ".json"
    If fso.FileExists(jsonPath) Then
        fso.MoveFile Source:=jsonPath, Destination:=backupPath
    End If
    
    ' 4. 将处理后的数据转回JSON并导出
    Dim updatedJsonObj As Object
    Set updatedJsonObj = ReadSheetToJSON(wsJSON.Range("A1").CurrentRegion)
    
    ' 生成格式化的JSON文本（带缩进，可读性强）
    Dim updatedJsonText As String
    updatedJsonText = JsonConverter.ConvertToJson(updatedJsonObj, Whitespace:=2)
    
    ' 写入新文件
    Open jsonPath For Output As #1
    Print #1, updatedJsonText
    Close #1
    
    MsgBox "JSON更新完成！原文件已备份为：" & backupPath, vbInformation
End Sub

' 辅助函数：递归将JSON对象写入工作表（适配嵌套结构）
Sub WriteJSONToSheet(jsonObj As Object, targetCell As Range)
    Dim key As Variant
    Dim currentRow As Long
    currentRow = targetCell.Row
    
    If TypeName(jsonObj) = "Dictionary" Then
        ' 处理JSON对象（键值对）
        For Each key In jsonObj.Keys
            targetCell.Offset(currentRow - targetCell.Row, 0).Value = key
            Select Case TypeName(jsonObj(key))
                Case "Dictionary", "Collection"
                    WriteJSONToSheet jsonObj(key), targetCell.Offset(currentRow - targetCell.Row, 1)
                    currentRow = currentRow + jsonObj(key).Count
                Case Else
                    targetCell.Offset(currentRow - targetCell.Row, 1).Value = jsonObj(key)
                    currentRow = currentRow + 1
            End Select
        Next key
    ElseIf TypeName(jsonObj) = "Collection" Then
        ' 处理JSON数组
        For Each key In jsonObj
            Select Case TypeName(key)
                Case "Dictionary", "Collection"
                    WriteJSONToSheet key, targetCell.Offset(currentRow - targetCell.Row, 0)
                    currentRow = currentRow + key.Count
                Case Else
                    targetCell.Offset(currentRow - targetCell.Row, 0).Value = key
                    currentRow = currentRow + 1
            End Select
        Next key
    End If
End Sub

' 辅助函数：递归将工作表数据转回JSON对象
Function ReadSheetToJSON(dataRange As Range) As Object
    Dim jsonObj As Object
    Dim i As Long
    Dim keyVal As String, valVal As String
    
    Set jsonObj = CreateObject("Scripting.Dictionary")
    
    For i = 1 To dataRange.Rows.Count
        keyVal = dataRange.Cells(i, 1).Value
        valVal = dataRange.Cells(i, 2).Value
        
        If valVal <> "" Then
            ' 判断是否为嵌套JSON，递归处理
            If (InStr(valVal, "{") > 0 Or InStr(valVal, "[") > 0) And dataRange.Columns.Count > 2 Then
                Set jsonObj(keyVal) = ReadSheetToJSON(dataRange.Offset(i, 1).Resize(, dataRange.Columns.Count - 1))
            Else
                jsonObj(keyVal) = valVal
            End If
        End If
    Next i
    
    Set ReadSheetToJSON = jsonObj
End Function

关键注意事项 #

• 确保你的「替换规则」工作表中，A列是旧值，B列是新值，第一行作为表头（宏从第2行开始读取替换规则）
• 在VBA编辑器的「工具-引用」中，勾选Microsoft Scripting Runtime，否则文件操作会报错
• 如果你的JSON是特殊结构（比如纯数组、多层嵌套对象），可以微调WriteJSONToSheet和ReadSheetToJSON函数的逻辑来适配
• 路径要改成你实际的JSON文件路径，注意使用反斜杠\，不要用正斜杠

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