最近在工作中遇到了一個數據處理的問題，需要將多層次的 Excel 數據轉化成 JSON 格式，這里通過 Excel VBA 實現。下面是實現的代碼：

Sub excelToJson()
Dim jsonObj As Object
Set jsonObj = CreateObject("Scripting.Dictionary")
Dim sheetName As String
sheetName = "Sheet1"
Dim lastRow As Long
lastRow = Worksheets(sheetName).Cells(Rows.Count, 1).End(xlUp).Row
Dim lastCol As Long
lastCol = Worksheets(sheetName).Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lastRow
Set currentObj = jsonObj
For j = 2 To lastCol
Dim key As String
key = Worksheets(sheetName).Cells(1, j).Value
If Not currentObj.Exists(key) Then
Dim obj As Object
Set obj = CreateObject("Scripting.Dictionary")
currentObj.Add key, obj
Set currentObj = obj
Else
Set currentObj = currentObj.Item(key)
End If
If j = lastCol Then
currentObj.Add Worksheets(sheetName).Cells(i, 1).Value, Worksheets(sheetName).Cells(i, j).Value
End If
Next
Next
Dim jsonStr As String
jsonStr = jsonToString(jsonObj)
MsgBox jsonStr
End Sub
Function jsonToString(obj As Object) As String
Dim jsonStr As String
jsonStr = "{"
Dim key As Variant
For Each key In obj.Keys
Dim value As Variant
value = obj.Item(key)
Dim valueType As String
valueType = TypeName(value)
If valueType = "Dictionary" Then
jsonStr = jsonStr & """" & key & """:"
jsonStr = jsonStr & jsonToString(value)
jsonStr = jsonStr & ","
Else
jsonStr = jsonStr & """" & key & """:""" & value & ""","
End If
Next
If Right(jsonStr, 1) = "," Then
jsonStr = Left(jsonStr, Len(jsonStr) - 1)
End If
jsonStr = jsonStr & "}"
jsonToString = jsonStr
End Function

首先，創建了一個 Scripting.Dictionary 對象來存儲轉化后的 JSON 數據。接著，獲取 Excel 表格的行數和列數，并通過循環逐個處理每個單元格的數據。通過查看 Excel 表格可以看出，第一行為 JSON 數據的第一層，下標為 1 的列為 JSON 數據的第二層，以此類推。

首先通過循環遍歷第一行的頭部字段，若該字段不存在，則說明需要新建一個 Scripting.Dictionary 對象來存儲下一層的數據。反之，則直接使用已存在的對象。如果是最后一個字段，則將當前單元格的內容作為最后一層的值存儲到當前對象中。

最后，通過遞歸方式將 Scripting.Dictionary 對象轉化成 JSON 字符串。這里用到了 TypeName 函數來區分 JSON 中字段值的類型，值類型為“Dictionary”時，需要遞歸將其轉化成 JSON 字符串。

總的來說，通過 VBA 可以很好地處理多層次的 Excel 數據，并將其轉化成 JSON 格式。