VBA vlookup/group by 到锯齿状数组答案

【问题标题】：VBA vlookup/group by to jagged arrayVBA vlookup/group by 到锯齿状数组
【发布时间】：2013-04-04 18:06:30
【问题描述】：

假设我的电子表格中有两列A和B：

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

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

【问题讨论】：

请看这个链接stackoverflow.com/questions/15846060/…
我不认为这是可能的，你的 arr 有什么尺寸？
@Juliusz 是正确的，不可能创建具有这些维度的数组。但是，您可以存储 Collection 的数组。
可以将其存储为 Variant（如数组数组）。维度将是 B 中唯一项目的数量。

标签： vba excel jagged-arrays

【解决方案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

【讨论】：

【解决方案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

【讨论】：

@Morten，仅供参考，我刚刚测试了我的代码并改进了一些错误！