0

Facebook FQLクエリからの情報をJSON形式で取得し、Excelに貼り付けました。結果の一部は次のとおりです。

"データ"： [

{
  "name": "Hilton Head Island - TravelTell", 
  "location": {
    "street": "7 Office Way, Suite 215", 
    "city": "Hilton Head Island", 
    "state": "SC"
  }, 
  "fan_count": 143234, 
  "talking_about_count": 18234, 
  "were_here_count": 4196
}, 
{
  "name": "Hilton Hawaiian Village Waikiki Beach Resort", 
  "location": {
    "street": "2005 Kalia Road", 
    "city": "Honolulu", 
    "state": "HI"
  }, 
  "fan_count": 34072, 
  "talking_about_count": 4877, 
  "were_here_count": 229999
}, 
{
  "name": "Hilton New York", 
  "location": {
    "street": "1335 Avenue of the Americas", 
    "city": "New York", 
    "state": "NY"
  }, 
  "fan_count": 12885, 
  "talking_about_count": 969, 
  "were_here_count": 72206
},

サブストリングを使用してデータを解析し、「name、street、city、state、fan_countなど」を使用して別のワークシートに列を作成しようとしています。列ヘッダーとして。現在、「name：」だけでこれを行うコードを試していますが、documentText=myRange.Textの行にヒットするとエラーが発生します。エラーが何であるかわかりません。

もう1つの問題は、文字列に引用符が含まれていることです。たとえば、SecondTermを "にしたいのですが、" "、"と等しくしようとするとエラーが発生します。

Sub Substring_Test（）

Dim nameFirstTerm As String
Dim nameSecondTerm As String
Dim myRange As Range
Dim documentText As String

Dim startPos As Long 'Stores the starting position of firstTerm
Dim stopPos As Long 'Stores the starting position of secondTerm based on first term's location
Dim nextPosition As Long 'The next position to search for the firstTerm

nextPosition = 1

'First and Second terms as defined by your example.  Obviously, this will have to be more dynamic
'if you want to parse more than justpatientFirstname.
firstTerm = "name"": """
secondTerm = ""","""

'Get all the document text and store it in a variable.
Set myRange = Sheets("Sheet1").UsedRange
'Maximum limit of a string is 2 billion characters.
'So, hopefully your document is not bigger than that.  However, expect declining performance based on how big doucment is
documentText = myRange.Text

'Loop documentText till you can't find any more matching "terms"
Do Until nextPosition = 0
    startPos = InStr(nextPosition, documentText, firstTerm, vbTextCompare)
    stopPos = InStr(startPos, documentText, secondTerm, vbTextCompare)
    Debug.Print Mid$(documentText, startPos + Len(firstTerm), stopPos - startPos - Len(secondTerm))
    nextPosition = InStr(stopPos, documentText, firstTerm, vbTextCompare)
Loop

Sheets("Sheet2").Range("A1").Value = documentText

サブ終了

4

3 に答える 3

2 
Sub Tester()

    Dim json As String
    Dim sc As Object
    Dim o, loc, x, num

    Set sc = CreateObject("scriptcontrol")
    sc.Language = "JScript"

    json = ActiveSheet.Range("a1").Value
    'Debug.Print json

    sc.Eval "var obj=(" & json & ")" 'evaluate the json response

    'Add some accessor functions...
    '  get count of records returned
    sc.AddCode "function getCount(){return obj.data.length;}"

    '  return a specific record (with some properties renamed)
    sc.AddCode "function getItem(i){var o=obj.data[i];" & vbLf & _
                      "return {nm:o.name,loc:o.location," & vbLf & _
                      "f:o.fan_count,ta:o.talking_about_count," & vbLf & _
                      "wh:o.were_here_count};}"

    num = sc.Run("getCount")
    Debug.Print "#Items", num

    For x = 0 To num - 1
        Debug.Print ""
        Set o = sc.Run("getItem", x)
        Debug.Print "Name", o.nm
        Debug.Print "Street", o.loc.street
        Debug.Print "City", o.loc.city
        Debug.Print "Street", o.loc.street
        Debug.Print "Fans", o.f
        Debug.Print "talking_about", o.ta
        Debug.Print "were_here", o.wh
    Next x

End Sub

注： javascriptgetItem関数はレコードを直接返しませんが、データをラップして、JSON駆動のプロパティ名の一部（具体的には「name」と「location」）を変更します。Nameプロパティ名が（または）のような「通常の」プロパティに似ている場合、VBAはjavascriptから渡されたオブジェクトのプロパティへのアクセスに問題があるようLocationです。

于 2013-02-25T20:15:57.360 に答える
1

最初の部分（JSONにまったく精通していない）についてはわかりませんが、2番目の部分については次の行を試してください。

firstTerm = Chr(34) & "name: " & Chr(34)
secondTerm = Chr(34) & ","

または単に-必要Chr(34)なすべての二重引用符に使用します。

于 2013-02-25T18:15:45.960 に答える
1

シート名の一部を変更する必要があるかもしれませんが、これは機能するはずです

Sub Test()
    Dim vData() As Variant
    Dim vHeaders As Variant
    Dim vCell As Variant
    Dim i As Long

    vHeaders = Array("Name", "Street", "City", "State", "Fan Count", "Talking About Count", "Were Here Count")

    i = 1
    Do While i <= ActiveSheet.UsedRange.Rows.Count
        If InStr(Cells(i, 1).Text, "{") Or _
           InStr(Cells(i, 1).Text, "}") Or _
           Cells(i, 1).Text = """data"": [" Or _
           Cells(i, 1).Text = "" Then
            Rows(i).Delete
        Else
            Cells(i, 1).Value = Replace(Cells(i, 1).Text, """", "")
            Cells(i, 1).Value = Replace(Cells(i, 1).Text, ",", "")
            Cells(i, 1).Value = WorksheetFunction.Trim(Cells(i, 1).Text)
            i = i + 1
        End If
    Loop

    i = 0
    For Each vCell In Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1))
        If InStr(vCell.Text, "name:") Then
            i = i + 1
            ReDim Preserve vData(1 To 7, 1 To i)
        End If

        If InStr(vCell.Text, "name") Then
            vData(1, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))
        End If

        If InStr(vCell.Text, "street") Then
            vData(2, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))

        End If

        If InStr(vCell.Text, "city") Then
            vData(3, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))

        End If

        If InStr(vCell.Text, "state") Then
            vData(4, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))
        End If

        If InStr(vCell.Text, "fan_count") Then
            vData(5, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))

        End If

        If InStr(vCell.Text, "talking_about_count") Then
            vData(6, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))

        End If

        If InStr(vCell.Text, "were_here_count") Then
            vData(7, i) = Right(vCell.Text, Len(vCell.Text) - InStr(1, vCell.Text, ":"))
        End If
    Next

    'Cells.Delete
    Sheets("Sheet2").Select
    Range(Cells(1, 1), Cells(UBound(vData, 2), UBound(vData))).Value = WorksheetFunction.Transpose(vData)
    Rows(1).EntireRow.Insert
    Range(Cells(1, 1), Cells(1, UBound(vHeaders) + 1)).Value = vHeaders

End Sub
于 2013-02-25T19:14:58.623 に答える