修改Excel VBA转JSON代码：固定工作表首行为表头

原代码会将选中数据范围的首行作为表头生成JSON，现在需要调整为始终以工作表第一行作为固定表头，无论选中哪一行或多行数据，都基于该表头生成JSON。

修改后的完整代码 #

Function ExcelToJSON(rng As Range) As Variant
    ' 检查选中范围至少包含2列
    If rng.Columns.Count < 2 Then
        ExcelToJSON = CVErr(xlErrNA)
        Exit Function
    End If
    
    Dim dataLoop As Long, headerLoop As Long
    ' 固定取工作表第一行、与选中范围对应列的区域作为表头
    Dim headerRange As Range
    Set headerRange = Sheet1.Range(Sheet1.Cells(1, rng.Column), Sheet1.Cells(1, rng.Column + rng.Columns.Count - 1))
    
    Dim colCount As Long: colCount = headerRange.Columns.Count
    Dim JSON As String: JSON = "["
    
    ' 遍历选中范围的每一行（所有行都是数据行，无需跳过）
    For dataLoop = 1 To rng.Rows.Count
        Dim jsonData As String: jsonData = "{"
        ' 循环匹配表头与数据列
        For headerLoop = 1 To colCount
            jsonData = jsonData & """" & headerRange.Value2(1, headerLoop) & """" & ":"
            jsonData = jsonData & """" & rng.Value2(dataLoop, headerLoop) & """"
            jsonData = jsonData & ","
        Next headerLoop
        
        ' 移除行末多余逗号
        jsonData = Left(jsonData, Len(jsonData) - 1)
        JSON = JSON & jsonData & "},"
    Next
    
    ' 移除最后一行的多余逗号并闭合JSON数组
    If Len(JSON) > 1 Then
        JSON = Left(JSON, Len(JSON) - 1)
    End If
    JSON = JSON & "]"
    
    ExcelToJSON = JSON
End Function

关键修改点 #

• 表头范围调整：把原代码中取选中范围首行的逻辑，改为取工作表第一行、与选中范围列匹配的区域，确保表头固定为工作表第一行内容
• 移除数据行跳过逻辑：删除原代码中If dataLoop > 1 Then的判断，因为选中的所有行都是数据行，无需跳过
• 增加容错处理：添加If Len(JSON) > 1 Then判断，避免选中范围为空时出现JSON格式错误

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