如何用Excel VBA批量生成多列对应结构的JSON文件

嘿，我刚好处理过类似的需求，给你整理了一套完美的Excel宏解决方案，完全匹配你要的功能！

先明确下需求对应逻辑 #

• 每一列的第一行内容，就是对应JSON文件的文件名（比如B1是b1就生成b1.json）
• A列的行内容（A2、A3...）作为JSON对象的键
• 每一列的对应行值（B列对应B2、B3...，C列对应C2、C3...）作为键的值，生成格式为[{"a2":"b2","a3":"b3"...}]的JSON文件
• 所有文件自动保存到当前Excel所在的目录

完整宏代码实现 #

直接把这段代码复制到VBA模块里就能用：

Sub GenerateJSONFiles()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim lastCol As Integer
    Dim fileName As String
    Dim jsonContent As String
    Dim fso As Object
    Dim outputPath As String
    Dim i As Long, j As Integer
    
    ' 绑定当前活动工作表
    Set ws = ActiveSheet
    ' 获取Excel文件所在的目录路径
    outputPath = ThisWorkbook.Path & "\"
    ' 创建文件操作对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 自动获取数据的最后一行和最后一列
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ' 遍历每一列（从第二列开始，因为第一列是键）
    For j = 2 To lastCol
        ' 提取第一行的文件名，自动加.json后缀
        fileName = Trim(ws.Cells(1, j).Value)
        If fileName = "" Then
            MsgBox "第" & j & "列的文件名不能为空，跳过该列！"
            GoTo NextColumn
        End If
        fileName = fileName & ".json"
        
        ' 初始化JSON的开头结构
        jsonContent = "[{"
        
        ' 遍历每一行数据（从第二行开始，跳过表头）
        For i = 2 To lastRow
            Dim keyStr As String, valueStr As String
            keyStr = Trim(ws.Cells(i, 1).Value)
            valueStr = Trim(ws.Cells(i, j).Value)
            
            ' 如果键为空，跳过该行并提示
            If keyStr = "" Then
                MsgBox "第" & i & "行的键为空，跳过该行！"
                GoTo NextRow
            End If
            
            ' 拼接键值对，默认把值作为字符串处理（加双引号）
            ' 如果你的值是纯数字，可以把""" & valueStr & """改成valueStr
            jsonContent = jsonContent & """" & keyStr & """: """ & valueStr & """"
            
            ' 非最后一行的话，加逗号分隔键值对
            If i <> lastRow Then
                jsonContent = jsonContent & ", "
            End If
            
NextRow:
        Next i
        
        ' 补全JSON的结尾结构
        jsonContent = jsonContent & "}]"
        
        ' 写入JSON文件，用UTF-8编码避免乱码
        Dim txtFile As Object
        Set txtFile = fso.CreateTextFile(outputPath & fileName, True, True)
        txtFile.Write jsonContent
        txtFile.Close
        Set txtFile = Nothing
        
        MsgBox "已生成文件：" & outputPath & fileName
        
NextColumn:
    Next j
    
    Set fso = Nothing
    MsgBox "所有JSON文件生成完成！"
End Sub

代码细节说明 #

• 自动适配数据范围：不用手动设置行数列数，宏会自动识别A列最后一行和第一行最后一列的数据边界
• 异常处理：遇到空文件名或空键会弹出提示并跳过，避免生成无效文件
• 编码兼容：生成的JSON用UTF-8编码，解决中文乱码问题
• 灵活调整：如果你的值是纯数字，直接修改代码里的拼接逻辑即可（去掉值的双引号）

使用步骤 #

1. 打开你的Excel文件，先保存一次（不然宏获取不到文件路径）
2. 按Alt + F11打开VBA编辑器
3. 右键点击工程窗口里的当前工作簿 → 插入 → 模块
4. 把上面的代码复制粘贴到模块中
5. 返回Excel，按Alt + F8，选择GenerateJSONFiles宏并执行

额外提示 #

如果你的值里包含双引号，需要加一行转义处理，在valueStr = Trim(ws.Cells(i, j).Value)后面加：

valueStr = Replace(valueStr, """", "\""")

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