数据范围转换

时间:2015-09-29 21:10:16

标签: excel vba excel-vba

我有一个从服务调用返回的对象列表。

Object has below attributes:
DateVal1
DateVal2
Value

如何将对象指定为范围作为2D矩阵范围: Date1为列,Date2为标题行

如果有对象有行,列组合打印值则打印NA。

数据可能很大(最大30x30),因此每次都要避免在列表中查找。

Date     1/31/2015 2/28/2015 3/31/2015
1/1/2015 1         NA         NA
1/2/2015 NA        2          NA
1/3/2015 NA        NA         3

如果这有点不同怎么办?

 Object has below attributes:
    DateVal1
    DateVal2
    Value1
    Value2

希望o / p是这样的:

Date1     Date2             110        20         30
1/1/2015  1/10/2015          1         NA         NA
1/2/2015  1/20/2015         NA         2          NA
1/3/2015  1/31/2015         NA         NA         3

1 个答案:

答案 0 :(得分:2)

未经测试,但是像这样:

Sub Test()

    Dim points, i As Long, r As Long, c As Long
    Dim dictRows, dictCols, grid(0, 0)
    'dictionary to map "key" values to row numbers
    Set dictRows = CreateObject("scripting.dictionary")
    'dictionary to map "key" values to column numbers
    Set dictCols = CreateObject("scripting.dictionary")

    points = getPoints()
    r = 0
    c = 0

    '[sort points by date1 here]
    'map date1 to "row"
    For i = LBound(points) To UBound(points)
        If Not dictRows.exists(points(i).date1) Then
            r = r + 1
            dictRows.Add points(i).date1, r
        End If
    Next i
    '[sort points by date2 here]
    'map date2 to "column"
    For i = LBound(points) To UBound(points)
        If Not dictCols.exists(points(i).date2) Then
            c = c + 1
            dictCols.Add points(i).date2, c
        End If
    Next i

    ReDim grid(1 To r, 1 To c)

    For i = LBound(points) To UBound(points)
        grid(dictRows(points(i).date1), dictCols(points(i).date2)) = points(i).Value
    Next i

    'populate on worksheet
    With ActiveSheet
        .Range("A2").Resize(r, 1).Value = Application.Transpose(dictRows.keys)
        .Range("B2").Resize(r, c).Value = grid
        .Range("B1").Resize(1, c).Value = dictCols.keys
    End With

End Sub