vba - VBA vlookup/group by 到锯齿状数组

Question

假设我有两列A，并且B在我的电子表格中：

A       B
0.2     1
0.0     1
0.5     2
0.7     3
1.5     3
2.7     3
0.1     4

如何根据这样的值将其转换为锯齿状B数组

arr = [[0.2, 0.0],
       [0.5],
       [0.7, 1.5, 2.7],
       [0.1]]

Answer 1

这就是我所做的：

Dim uniqueT() As Variant: uniqueT = DistinctValues(Application.Transpose(Range("arrT")))
Dim nMaturities As Integer: nMaturities = UBound(uniqueT)
Dim nKnots As Integer, row As Integer

Dim K() As Variant: ReDim K(1 To nMaturities)
Dim mids() As Variant: ReDim mids(1 To nMaturities)

With Application.WorksheetFunction
    For i = 1 To nMaturities
        nKnots = .CountIf(Range("arrT"), "=" & uniqueT(i))
        row = .Match(uniqueT(i), Range("arrT"), False) - 1
        K(i) = .Transpose(Range("arrK").Cells(1).Offset(row, 0).Resize(nKnots, 1))
        mids(i) = .Transpose(Range("arrMid").Cells(1).Offset(row, 0).Resize(nKnots, 1))
    Next i
End With

Answer 2

我不认为你会得到一个锯齿状的数组，但如果没有值，下面会给你最大数量和空白的空间。

Sub jag_array()

    Dim maxcolb As Long, countcolb As Long, arr() As Variant
    maxcolb = Application.Max(Columns(2))
    countcolb = 1

    ReDim arr(1 To maxcolb, 1 To countcolb) As Variant
    'cycle through all values eg 1 to 4
    For i = 1 To maxcolb

        'expand the array as required
        If Application.CountIf(Columns(2), i) > countcolb Then

            countcolb = Application.CountIf(Columns(2), i)
            ReDim Preserve arr(1 To UBound(arr, 1), 1 To countcolb) As Variant


        End If

        'find and cycle through all found column b
        Set c = Columns(2).Find(i, After:=Cells(1, 2), LookIn:=xlValues)
        If Not c Is Nothing Then

            j = 1
            firstAddress = c.Address
            Do
                'add column a value
                arr(i, j) = Cells(c.Row, 1).Value
                j = j + 1
                Set c = Columns(2).FindNext(c)

                If c Is Nothing Then Exit Do
            Loop While c.Address <> firstAddress
        End If
    Next

'use arr(x, y) as you need to

End Sub