我正在开展一个项目，我想知道如何解析这样的一行：
oDesign.ChangeProperty Array("NAME:AllTabs", Array("NAME:LocalVariableTab", Array("NAME:PropServers", "LocalVariables"), Array("NAME:NewProps", Array("NAME:antipad", "PropType:=", "VariableProp", "UserDef:=", true, "Value:=", "40mil")), Array("NAME:ChangedProps", Array("NAME:antipad", "Hidden:=", false))))
这样的事情：
oDesign.ChangeProperty(
[
"NAME:AllTabs",
[
"NAME:LocalVariableTab",
[
"NAME:PropServers",
"LocalVariables"
],
[
"NAME:NewProps",
[
"NAME:antipad",
"PropType:=" , "VariableProp",
"UserDef:=" , True,
"Value:=" , "40mil"
]
],
[
"NAME:ChangedProps",
[
"NAME:antipad",
"Hidden:=" , False,
"Value:=" , "40mil"
]
]
]
])
我在考虑使用字典，但我不确定如何使用VBA。
此外，有关缩进的建议表示赞赏。我在考虑使用堆栈，但我确信有更简单的方法可以实现它。
答案 0 :(得分：0)
如果目标是从这种VBA阵列中获取JSON，那么这可能是一种方法：
Sub test()
arr = Array("NAME:AllTabs", Array("NAME:LocalVariableTab", Array("NAME:PropServers", "LocalVariables"), Array("NAME:NewProps", Array("NAME:antipad", "PropType:=", "VariableProp", "UserDef:=", True, "Value:=", "40mil")), Array("NAME:ChangedProps", Array("NAME:antipad", "Hidden:=", False))))
sJSON = "[" & recursiveVBAArrayToJSON(arr, "") & vbLf & "]"
MsgBox sJSON
End Sub
Function recursiveVBAArrayToJSON(arr As Variant, res As String) As String
For i = LBound(arr) To UBound(arr)
If TypeName(arr(i)) = "Variant()" Then
res = res & vbLf & "["
res = recursiveVBAArrayToJSON(arr(i), res)
res = res & vbLf & "]" & IIf(i <> UBound(arr), ",", "")
Else
res = res & vbLf & """" & arr(i) & """" & IIf(i <> UBound(arr), ",", "")
End If
Next
recursiveVBAArrayToJSON = res
End Function
答案 1 :(得分：0)
Axel创建他的解决方案比我创建他的解决方案更快，除非我认为早期的解决方案有问题，否则我通常不会发布竞争对手的解决方案。 Axel的解决方案看起来并不错，但是他没有处理缩进（你特别提到它是重要的），也没有将“Xxxx =”与值连接起来。我也认为Axel使用递归而不是集合是正确的。但是，我决定将这个答案作为一个可能有趣的替代方案发布。
您可以在不使用内置集合的情况下使用Excel VBA。但是，我很少有用户集合或词典，因为我通常不会解决大到足以在VBA中需要它们的问题。这个要求看起来很简单，所以我想我会把它当作一个训练练习。
我对字典的理解是一把钥匙是强制性的。没有明显的键，所以我使用了集合。
以下代码是基本的。我已经执行了最少的验证，我确信我可以以更优雅的方式处理输出。我限制自己“可以做到吗？”
我已将您的字符串放在工作表“Sheet1”的单元格A1中，作为使其可用于宏的最简单方法。
我的输出不包括尾随的“”值：=“，”40mil“”，因为它不在输入字符串中。
我一直处理缩进，我使用了常量，因此您可以轻松更改空格数。字符串和逗号之间的空格数在您所需的输出中似乎不一致，因此我几乎没有尝试匹配它。但是，我认为这是一个小细节;你问的答案是“是的，你的字符串可以被解析并转换成你想要的输出。”
Option Explicit
Enum EVT
DCP
ArrayOpen
ArrayClose
Comma
Str
BoolTrue
BoolFalse
End Enum
Sub Control()
Dim InxOutput As Long
Dim InxToken As Long
Dim Output As New Collection
Dim StrToParse As String
Dim Tokens As New Collection
StrToParse = Worksheets("Sheet1").Cells(1, 1).Value
Call Parse(StrToParse, Tokens)
For InxToken = 1 To Tokens.Count
Debug.Print Tokens.Item(InxToken)
Next
Call CreateOutput(Tokens, Output)
For InxOutput = 1 To Output.Count
Debug.Print Output.Item(InxOutput)
Next
Set Tokens = Nothing
Set Output = Nothing
End Sub
Sub Parse(ByVal Str As String, ByRef Tokens As Collection)
' Str is a string such as: oDesign.ChangeProperty Array("NAME:AllTabs", ...
' On entry, Token must be an empty collection.
' The routine parses Str and creates tokens in Tokens of the form:
' nn¬mm¬xxxxx
' where:
' * nn is the level of the token. 1 for the outer token, oDesign.ChangeProperty,
' and 2, 3 and so on for each nested array or array element
' * ¬ is a separator
' * mm is a enumerator defined by Enum EVT:
' * Enum Indicated token
' * DCP oDesign.ChangeProperty
' * ArrayOpen Array(
' * ArrayClose )
' * Comma ,
' * Str Quoted string
' * BoolTrue true
' * BoolFalse false
' * xxxxx with its preceding ¬ is only present for a quoted string. The value
' of xxxxx is the quoted string without the quotes.
Dim LevelCrnt As Long
Dim PosStrCrnt As Long
Dim PosStrQuote As Long
PosStrCrnt = 1
LevelCrnt = 1
If Mid(Str, PosStrCrnt, 22) <> "oDesign.ChangeProperty" Then
Debug.Assert False
' String does not start as expected
Exit Sub
End If
Tokens.Add LevelCrnt & "¬" & EVT.DCP
LevelCrnt = LevelCrnt + 1
PosStrCrnt = PosStrCrnt + 22
Do While PosStrCrnt < Len(Str)
If Mid(Str, PosStrCrnt, 1) = " " Then
' Step over space
PosStrCrnt = PosStrCrnt + 1
ElseIf Mid(Str, PosStrCrnt, 1) = "," Then
' Comma
Tokens.Add LevelCrnt & "¬" & EVT.Comma
PosStrCrnt = PosStrCrnt + 1
ElseIf Mid(Str, PosStrCrnt, 1) = ")" Then
' End of array
LevelCrnt = LevelCrnt - 1
Tokens.Add LevelCrnt & "¬" & EVT.ArrayClose
PosStrCrnt = PosStrCrnt + 1
ElseIf Mid(Str, PosStrCrnt, 6) = "Array(" Then
' Start of array
Tokens.Add LevelCrnt & "¬" & EVT.ArrayOpen
LevelCrnt = LevelCrnt + 1
PosStrCrnt = PosStrCrnt + 6
ElseIf Mid(Str, PosStrCrnt, 1) = """" Then
' Quoted string
PosStrCrnt = PosStrCrnt + 1
PosStrQuote = InStr(PosStrCrnt, Str, """")
If PosStrQuote = 0 Then
' Unterminated string
Debug.Assert False
Exit Sub
End If
Tokens.Add LevelCrnt & "¬" & EVT.Str & "¬" & Mid(Str, PosStrCrnt, PosStrQuote - PosStrCrnt)
PosStrCrnt = PosStrQuote + 1
ElseIf Mid(Str, PosStrCrnt, 4) = "true" Then
Tokens.Add LevelCrnt & "¬" & EVT.BoolTrue
PosStrCrnt = PosStrCrnt + 4
ElseIf Mid(Str, PosStrCrnt, 5) = "false" Then
Tokens.Add LevelCrnt & "¬" & EVT.BoolFalse
PosStrCrnt = PosStrCrnt + 5
Else
' Unexpected token
Debug.Print PosStrCrnt & ": " & Mid(Str, PosStrCrnt, 20)
Debug.Assert False
Exit Sub
End If
Loop
End Sub
Sub CreateOutput(ByRef Tokens As Collection, ByRef Output As Collection)
' Tokens is a collection of tokens created by Parse
' On entry. Output is an empty collection
' On exit, Output is an human readable version of Tokens
' The routine processes the contents in sequence.
Dim ContinuePending As Boolean
Dim EVTCrnt As Long
Dim InxToken As Long
Dim InxPart As Long
Dim LevelCrnt As Long
Dim Part() As String
Dim Pending As String
Const SpacesPerLevel As Long = 4
Pending = ""
ContinuePending = False
For InxToken = 1 To Tokens.Count
' Split token into components
Part = Split(Tokens.Item(InxToken), "¬")
LevelCrnt = Val(Part(0))
EVTCrnt = Val(Part(1))
Select Case EVTCrnt
Case EVT.DCP
Debug.Assert LevelCrnt = 1
' No indent for level 1
Output.Add ("oDesign.ChangeProperty(")
Case EVT.ArrayOpen
' Ouput [ in line with array's parent
Output.Add (Space((LevelCrnt - 2) * SpacesPerLevel) & "[")
Case EVT.ArrayClose
If Pending <> "" Then
' The final contents of this array have not been output
Output.Add (Space((LevelCrnt - 1) * SpacesPerLevel) & Pending)
Pending = ""
End If
' Ouput ] or ]) in line with array's parent
If InxToken = Tokens.Count Then
' This is the close of the final array. Include closing bracket
Output.Add ("])")
Else
' This may be a nested array with a following comma
Pending = "]"
End If
Case EVT.Comma
' Add to Pending
Pending = Pending & ","
If Not ContinuePending Then
' The next string is not to be added to Pending so output
Output.Add (Space((LevelCrnt - 2) * SpacesPerLevel) & Pending)
Pending = ""
End If
Case EVT.Str
If Pending <> "" Then
' This string is to be appended to previous token
Pending = Pending & " """ & Part(2) & """"
Else
' This is a new string
Pending = """" & Part(2) & """"
End If
If Right(Part(2), 2) = ":=" Then
' The next string is to be appended to this one
ContinuePending = True
' Add some spaces before comma
Pending = Pending & " "
Else
ContinuePending = False
' Don't output in case comma is to be appended
End If
Case BoolTrue
If Pending <> "" Then
' This string is to be appended to previous token
Pending = Pending & " ""True"""
Else
' This is a new string
Pending = """True"""
End If
' True cannot be continued but there may be a following comma
ContinuePending = False
Case BoolFalse
If Pending <> "" Then
' This string is to be appended to previous token
Pending = Pending & " ""False"""
Else
' This is a new string
Pending = """False"""
End If
' False cannot be continued but there may be a following comma
ContinuePending = False
End Select
Next
If Pending <> "" Then
' Final output
Output.Add Pending
Pending = ""
End If
End Sub