如何将数组从(x,y)(z)尺寸转换为(x,y)尺寸?

时间:2019-11-06 22:28:36

标签: vba ms-access

我正在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
'''

enter image description here

这是我得到彭博数组时的样子。我不确定如何真正解决此问题。上面程序中的数组只是空白。

1 个答案:

答案 0 :(得分:2)

Bloomberg数组的每个元素都将返回2组数据。关键是使您的数组的数量是顶级彭博社数组的两倍。

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

不知道数组嵌套,但是知道我们正在返回数据对,我们可以将所有数据添加到集合中并创建遍历集合的数组。

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

Locals Window