UDF从通用字符串中提取特定数据

Question

我正在尝试创建一个= Extractinfo（“ A2”，“ Name”）之类的函数，该函数可以从原始数据中提取姓名，电话和电子邮件ID，这是所有3种提取中的一个函数，我已经有一个函数可以提取电子邮件ID

 Raw Data

"Name":"Ram","Phone":"9898989898","Email":"abcd@gmail.com"
"Name":"Raju","Phone":"2323232323","Email":"xyz123@gmail.com"
"Name":"Rameshsing","Phone":"555999999","Email":"rameshsing@gmail.com"

(Function to extract)          (Expected Result)
=Extractinfo("A2","Name")      Ram
=Extractinfo("A2","Name")      Raju
=Extractinfo("A4","Name")      Rameshsing


Function ExtractEmailFun(extractStr As String) As String

 Dim CharList As String
 On Error Resume Next
CheckStr = "[A-Za-z0-9._-]"
OutStr = ""
Index = 1
Do While True
Index1 = VBA.InStr(Index, extractStr, "@")
getStr = ""
If Index1 > 0 Then
    For p = Index1 - 1 To 1 Step -1
        If Mid(extractStr, p, 1) Like CheckStr Then
            getStr = Mid(extractStr, p, 1) & getStr
        Else
            Exit For
        End If
    Next
    getStr = getStr & "@"
    For p = Index1 + 1 To Len(extractStr)
        If Mid(extractStr, p, 1) Like CheckStr Then
            getStr = getStr & Mid(extractStr, p, 1)
        Else
            Exit For
        End If
    Next
    Index = Index1 + 1
    If OutStr = "" Then
        OutStr = getStr
    Else
        OutStr = OutStr & Chr(10) & getStr
    End If
Else
      Exit Do
End If
Loop
ExtractEmailFun = OutStr
End Function

Answer 1

您的RAW数据似乎与JSON格式匹配。可以做的一件事是使用一个模块（例如this one对我来说很好用）来解析它（即在其中排列一些顺序，以便您可以轻松获得所需的结果）。

按照simple instructions将此模块添加到您的VBA项目中（请记住要添加Microsoft.Scripting Reference！）。然后您的函数将如下所示：

Public Function Extractinfo(byval CompleteString as String, byval FieldName as String) as String

    Dim JSON as Object
    Set JSON = JsonConverter.ParseJson(CompleteString)

    ExtractInfo = JSON(FieldName)

End Function

此代码示例过于简化（没有任何错误处理），但这应该使您入门。

Answer 2

怎么样：

Public Function ExtractInfo(s As String, choice As String) As String

    dq = Chr(34)
    arr = Split(s, dq)

    If choice = "Name" Then
        ExtractInfo = arr(3)
        Exit Function
    End If

    If choice = "Phone" Then
        ExtractInfo = arr(7)
        Exit Function
    End If

    If choice = "Email" Then
        ExtractInfo = arr(11)
        Exit Function
    End If

    ExtractInfo = "bad data"
End Function

这假设您的所有数据都遵循相同的架构。选项为：

=extractinfo(A1,"Name")
=extractinfo(A1,"Phone")
=extractinfo(A1,"Email")

您也可以使用Case。