Question

在我的表中，我有一个单元格A1，其中包含一个数组，其格式为以下格式：[{'type':'general', 'name':'light'},{'type':'brand', 'name':'lighti'},{'type':'misc', 'name':'Sale%'}]

现在，我想创建一个新的表格，并将品牌名称“ lighti”作为单独的单元格值。这意味着：我想获取A1中的值，找到类型“ brand”，然后返回品牌名称并将其粘贴到A2中。就是这样。

如何使用VBA提取数组的值？

Answer 1

您可以将ActiveX ScriptControl与Language设置为JScript一起使用，并将字符串解析为实际的JSON。

然后，您只需编写一个Javascript函数即可根据“类型”返回“名称”。为此，您不需要任何外部库/其他宏等。

Option Explicit
Public Sub UseScriptControlAndJSON()
    Dim JsonObject As Object
    Dim resultString As String
    Dim ScriptEngine As Object

    'get the script control:
    Set ScriptEngine = CreateObject("ScriptControl")
    ScriptEngine.Language = "JScript"

    'Add javascript to get the "name" based on "typeName":
    ScriptEngine.AddCode "function findByType(jsonObj, typeName) { for (var i = 0; i < jsonObj.length; i++) { if (jsonObj[i].type == typeName){ return jsonObj[i].name; }}}"

    'Get the string and parse it:
    Set JsonObject = ScriptEngine.Eval("(" & Range("A1").Value & ")")

    'Now get the resulting "name" using the JS function, by passing in "brand" as type:
    resultString = ScriptEngine.Run("findByType", JsonObject, "brand")

    'Will pop-up: "lighti"
    MsgBox resultString
End Sub

注1：JS函数将返回第一次出现的情况。

注意2：严格来说，您不是使用VBA提取值。

注3：在64位计算机上使用32位Excel 2016进行了测试；脚本控件是32位组件-例如，请参见此question+answers-在64位上，您可以根据该链接中的答案之一，使其与某些变通办法一起使用。

Answer 2

假设品牌每次都在品牌名称之前

<fop version="1.0">
<renderers>
    <renderer mime="application/pdf">
        <fonts>
            <font embed-url="Nudi_05_k.ttf" kerning="yes">
                <font-triplet name="kannada" style="normal"
                    weight="normal" />
            </font>
            <!-- <font embed-url="Nudi_05_k.ttf" kerning="yes" sub-font="kannada"> 
                <font-triplet name="kannada" style="normal" weight="normal" /> </font> -->
        </fonts>
    </renderer>
</renderers>

Answer 3

您可以使用自定义函数从A1读取值，对搜索词进行拆分并解析出所需的信息。使用JSON解析器似乎有点矫extract过正，尽管该字符串是JSON，您可以用这种方式提取。

Option Explicit

Public Sub test()
    [A2] = GetValue([a1], "brand")
End Sub
Public Function GetValue(ByVal rng As Range, ByVal searchTerm As String) As Variant
    '[{'type':'general', 'name':'light'},{'type':'brand', 'name':'lighti'},{'type':'misc', 'name':'Sale%'}]
    On Error GoTo errhand
    GetValue = Split(Split(rng.Value, "{'type':'" & searchTerm & "', 'name':'")(1), "'")(0)
    Exit Function
errhand:
    GetValue = CVErr(xlErrNA)
End Function

如果您要使用JSONConverter.bas之类的JSONParser，则可以按以下方式解析JSON。注意：将.bas添加到项目中后，需要进入VBE>工具>引用，并添加对Microsoft脚本运行时的引用。

Option Explicit
Public Sub test()
    [A2] = GetValue([a1], "brand")
End Sub
Public Function ExtractItem(ByVal rng As Range, ByVal searchTerm As String) As Variant
    Dim json As Object, key As Object
    json = JsonConverter.ParseJson(rng.Value)
    For Each item In json
        For Each key In item
            If key = searchTerm Then
                GetValue = item(key)
                Exit Function
            End If
        Next
    Next
    ExtractItem = CVErr(xlErrNA)
End Function

如何使用VBA在Excel中从数组中提取值

3 个答案: