从api导入多个excel单元格答案

【问题标题】：Import from api into multiple excel cells从api导入多个excel单元格
【发布时间】：2015-06-10 15:22:50
【问题描述】：

我有一个显示二维数组的 api。

Array
(
    [0] => Array
        (
            [0] => 0
            [1] => 1
            [2] => 2
        )

    [1] => Array
        (
            [0] => 3
            [1] => 4
            [2] => 5
        )

)

如何将 api 导入到 excel 中，以便第一个数字 (0) 转到 A1。第二个数字 (1) 到 B1。像这样的

   A  B  C
1| 0  1  2
2| 3  4  5

【问题讨论】：

标签： vba excel

【解决方案1】：

如果您在 Excel 中已经有了数组，这相当简单，只需要确保您的范围与数组的大小相同，您可以使用数组的下边界和上边界来执行此操作，如下所示：

Sub MultiDimension()
Dim MyArr(2, 3) As Long
MyArr(0, 0) = 0
MyArr(0, 1) = 1
MyArr(0, 2) = 2
MyArr(1, 0) = 3
MyArr(1, 1) = 4
MyArr(1, 2) = 5
Range("A1:A1").Resize(UBound(MyArr, LBound(MyArr) + 1), UBound(MyArr, UBound(MyArr))) = MyArr
End Sub

编辑：这会做你想要的。

Sub ReadFromAPI()
Dim MyString As String, MyVal As String, D1 As Long, D2 As Long, MyArr() As Variant, X As Long, APIURL As String

APIURL = "http://iqamah.org/api/test.php"
With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", APIURL, False
    .Send
    MyString = .ResponseText
End With
If MyString <> "" Then
    D1 = ((Len(MyString) - Len(Replace(MyString, " => Array", ""))) / 9) - 1
    D2 = (Len(MyString) - Len(Replace(MyString, "(", ""))) - 1
    ReDim MyArr(D1, D2)
    For X = LBound(Split(MyString, vbLf)) To UBound(Split(MyString, vbLf))
        MyVal = Split(MyString, vbLf)(X)
        If Replace(MyVal, "=>", "") <> MyVal Then
            If Replace(MyVal, "=> Array", "") <> MyVal Then
                D1 = Mid(MyVal, InStr(1, MyVal, "[") + 1, (InStr(1, MyVal, "]")) - (InStr(1, MyVal, "[") + 1))
            Else
                D2 = Mid(MyVal, InStr(1, MyVal, "[") + 1, InStr(1, MyVal, "]") - (InStr(1, MyVal, "[") + 1))
                MyArr(D1, D2) = Right(MyVal, Len(MyVal) - (InStr(1, MyVal, "=> ")) - 2)
            End If
        End If
    Next
    Range("A1:A1").Resize(D1 + 1, D2 + 1) = MyArr
Else
    MsgBox "Nothing returned, Site might be down", vbOKOnly
End If
End Sub

作为工作表事件的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyString As String, MyVal As String, D1 As Long, D2 As Long, MyArr() As Variant, X As Long, APIURL As String

If Target = Range("M19") Then
    Application.EnableEvents = False
    APIURL = "http://iqamah.org/api/test.php?id=" & Target.Text
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", APIURL, False
        .Send
        MyString = .ResponseText
    End With
    If MyString <> "" Then
        D1 = ((Len(MyString) - Len(Replace(MyString, " => Array", ""))) / 9) - 1
        D2 = (Len(MyString) - Len(Replace(MyString, "(", ""))) - 1
        ReDim MyArr(D1, D2)
        For X = LBound(Split(MyString, vbLf)) To UBound(Split(MyString, vbLf))
            MyVal = Split(MyString, vbLf)(X)
            If Replace(MyVal, "=>", "") <> MyVal Then
                If Replace(MyVal, "=> Array", "") <> MyVal Then
                    D1 = Mid(MyVal, InStr(1, MyVal, "[") + 1, (InStr(1, MyVal, "]")) - (InStr(1, MyVal, "[") + 1))
                Else
                    D2 = Mid(MyVal, InStr(1, MyVal, "[") + 1, InStr(1, MyVal, "]") - (InStr(1, MyVal, "[") + 1))
                    MyArr(D1, D2) = Right(MyVal, Len(MyVal) - (InStr(1, MyVal, "=> ")) - 2)
                End If
            End If
        Next
        Range("A1:A1").Resize(D1 + 1, D2 + 1) = MyArr
    Else
        MsgBox "Nothing returned, Site might be down", vbOKOnly
    End If
    Application.EnableEvents = True
End If
End Sub

【讨论】：

没问题，乐于助人。
我稍微更新了网站.. 我收到这个连线错误 Run-time error '9': Subscript out of range
这是它突出显示 ReDim MyArr(D1, D2) 的行
您使用的是什么网址？我需要查看它试图分解的数据。
这与样本有很大不同，每个元素总是只有一个元素吗？

【解决方案2】：

我建议将 PHP 数组导出为 CSV 文件，结果应该如您所愿。

【讨论】：

【解决方案3】：

您为目标值指定的范围必须包含一些数字以避免错误...

您应该尝试以下更改，为我工作...

在Procedure Worksheet_Change()中更改这行代码：

D1 = ((Len(MyString) - Len(Replace(MyString, " => Array", ""))) / 9) - 1

加号（+）为：

D1 = ((Len(MyString) - Len(Replace(MyString, " => Array", ""))) / 9) + 1

还有这个

D2 = (Len(MyString) - Len(Replace(MyString, "(", ""))) - 1

用这个：

D2 = (Len(MyString) - Len(Replace(MyString, "(", ""))) + 1

然后使用以下过程运行代码：

Sub runCode()
    Worksheet_Change (Worksheets("sheet1").Range("m19"))
End Sub

【讨论】：