VBA VLOOKUP /組通過以鋸齒狀排列

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

我不認爲你會得到一個鋸齒形排列，但低於會給你FOT的最大數量和空白空間，如果沒有價值。

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