Этот код VBA будет работать:
Public Sub tojson()
savename = "exportedxls.json"
Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = ThisWorkbook
Set wks = wkb.Sheets(1)
lcolumn = wks.Cells(1, Columns.Count).End(xlToLeft).Column
lrow = wks.Cells(Rows.Count, "A").End(xlUp).Row
Dim titles() As String
ReDim titles(lcolumn)
For i = 1 To lcolumn
titles(i) = wks.Cells(1, i)
Next i
json = "["
dq = """"
For j = 2 To lrow
For i = 1 To lcolumn
If i = 1 Then
json = json & "{"
End If
cellvalue = wks.Cells(j, i)
json = json & dq & titles(i) & dq & ":" & dq & cellvalue & dq
If i <> lcolumn Then
json = json & ","
End If
Next i
json = json & "}"
If j <> lrow Then
json = json & ","
End If
Next j
json = json & "]"
myFile = Application.DefaultFilePath & "\" & savename
Open myFile For Output As #1
Print #1, json
Close #1
a = MsgBox("Saved as " & savename, vbOKOnly)
End Sub
Откройте VBA /Macros с помощью ALT+F11.
На левой стороне дважды щелкните по рабочему листу, с правой стороны вставьте код.
Установите для переменной savename
имя, которое вы хотите для файла json, и все.