vba - 如何将数组从（x，y）（z）维度转换为（x，y）维度？

Question

我正在使用 VBA 中的 Bloomberg API，我希望能够接收 API 从请求历史数据中发出的数组，并将其放入具有字段名称的表中。但是，API 给我的数组是以这种格式给出的：(x,y)(Z) 但我不能用它来插入表格。我还希望能够在从一种形式转换为另一种形式时将另一条数据添加到数组中

我已经尝试通过 Bloomberg 数组并替换不同数组中的每个元素，但我遇到的主要问题是无法知道我需要数组有多大以及我将如何在没有的情况下循环遍历 Bloomberg API超出索引并出现错误。我尝试过使用 Ubound，但它并没有按照我的预期工作。

这是我尝试用来转换我的数组然后插入它的代码。它只是放入空白值，并没有在表格中放入任何东西

Sub mWriteToTable(vTableName As String, ByVal vArray As Variant, vCUSIPS As Variant, vFields As Variant)
On Error GoTo ErrorHandler
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim x As Long, y As Long
    Dim TEST As String
    Dim DataArray() As Variant

    Set db = CurrentDb
    Set rs = db.OpenRecordset(vTableName, dbOpenDynaset, dbSeeChanges)
    TEST = ""
    Dim xBound As Integer, yBound As Integer, ThirdBound As Integer, fieldcount As Integer, NewBoundY As Integer, Z As Integer

    Dim Boundarynum As Integer
    Boundarynum = 0
    Dim Boundarynum1 As Integer
    Boundarynum1 = 0
    fieldcount = UBound(vFields, 1) + 1
    xBound = UBound(vArray, 1)
    yBound = UBound(vArray, 2)
    NewBoundY = fieldcount * (fieldcount + 1)
    ReDim DataArray(0 To 20, 0 To (xBound + 1))
    'using a static size for the array for now. Will try and make it the same size as the bloomberg array


   'TRANSFORMING ARRAY FROM BLOOMBERG


    For x = 0 To xBound
        For y = 0 To NewBoundY
            For Boundarynum1 = 0 To yBound
        On Error Resume Next
        DataArray(Boundarynum, Boundarynum1) = vArray(x, y)(Boundarynum1)

        Next
        Boundarynum = Boundarynum + 1
       Next
            Next
    'TRANSFORMING ARRAY FROM BLOOMBERG

    'set CUSIP in array
    y = 0
    Dim counter As Integer
    counter = 0
    For Z = 0 To 20

    If DataArray(Z, 0) = "" Then
    Debug.Print ("")
    counter = 1
    ElseIf counter = 1 And DataArray(Z, 0) <> "" Then
    y = y + 1
    DataArray(Z, 3) = vCUSIPS(y)
    counter = 0
    Else
     DataArray(Z, 3) = vCUSIPS(y)
        End If
        Next
    'set CUSIP in array

   For x = 0 To 20

        With rs
            .AddNew
            For y = 0 To yBound

'                    On Error GoTo Line1
'                     If vArray(x, y) = "NA" Then
'                    TEST = "This is a test"
'                    End If
'Line1:

                    .fields(y) = DataArray(x, y)







            Next
            .Update


        End With
    Next
    'Call fImmediateWindow(vArray)

ErrorHandler:

    If Err.Number <> 0 Then
        Dim vMsg As String
        vMsg = "Error # " & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
        MsgBox vMsg, , "Error", Err.HelpFile, Err.HelpContext
    End If

    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub
'''

这是我拿到彭博阵列时的样子。我不确定如何真正解决这个问题。上面程序中的数组变成了空白。

标签： vbams-access

Answer 1

Bloomberg 数组的每个元素都返回 2 组数据。关键是让您的数组的元素数量是顶级 Bloomberg 数组的两倍。

Sub ConvertBloombergTestData()
    Dim r As Variant
    r = getBloombergTestData

    Dim Values  As Variant
    Dim n As Long
    Dim j As Long
    Dim Item
    ReDim Values(1 To (UBound(r) + 1) * 2, 1 To 2)
    For n = LBound(r) To UBound(r)
        j = j + 1
        Item = r(n, 0)
        Values(j, 1) = Item(0)
        Values(j, 2) = Item(1)
        Item = r(n, 1)
        j = j + 1
        Values(j, 1) = Item(0)
        Values(j, 2) = Item(1)
    Next

End Sub

不知道数组嵌套但知道我们正在返回成对的数据，我们可以将所有数据添加到一个集合中并创建我们的数组 bu 迭代该集合。

Sub Test()
    Dim r As Variant, Values  As Variant
    r = getBloombergTestData
    Values = ConvertBloombergArrayTo2d(r)
End Sub

Function ConvertBloombergArrayTo2d(BloombergArray)
    Dim Map As New Collection

    FlattenArray Map, BloombergArray

    Dim Results As Variant
    ReDim Results(1 To Map.Count / 2, 1 To 2)
    Dim n As Long, j As Long

    For n = 1 To Map.Count Step 2
        j = j + 1
        Results(j, 1) = Map.Item(n)
        Results(j, 2) = Map.Item(n + 1)
    Next
    ConvertBloombergArrayTo2d = Results
End Function

Sub FlattenArray(Map As Collection, Element As Variant)
    If Right(TypeName(Element), 2) = "()" Then
        Dim Item
        For Each Item In Element
            FlattenArray Map, Item
        Next
    Else
        Map.Add Element
    End If
End Sub