vba - ギザギザ配列への VBA vlookup/group by

Question

スプレッドシートに2 つの列がある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