Превращение 1 столбца даты с 2 категориями в два столбца даты с VBA

Question

Как я могу превратить эту таблицу

ID  Date Type      Date
26  Date of Hire  01/15/1996
27  Date of Hire  10/01/2003
27  Seniority Date  12/04/1989
38  Date of Hire  07/13/2000
39  Date of Hire  06/01/1987
40  Date of Hire  12/11/1995
41  Date of Hire  05/01/2005
41  Seniority Date  09/22/1986

в эту таблицу, используя VBA

ID  Date Hired  Sen Date
26  01/15/1996  
27  10/01/2003  12/04/1989
38  07/13/2000  
39  06/01/1987  
40  12/11/1995  
41  05/01/2005  09/22/1986

Я пытался вычислить эту таблицу как можно дольше и не смог найтипохожий вопрос здесь, который работает с моими данными.

Цените любой ввод!

Вот код, с которым я играл, но я не могу заставить его работать. Я знаю, что большинство отделений, вероятно, не там, где они должны быть, и я не могу обойти ошибку, прокомментированную ниже.

    Sub LongtoWide()
Dim Rng         As Range
Dim Dn          As Range
Dim n           As Long
Dim Col         As Date
Dim twn         As String
Dim c           As Long
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count, 1 To 3)
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    twn = Dn & Dn.Offset(, 1)

   Col = Asc(Dn.Offset(, 1))
    If Not .Exists(twn) Then
        n = n + 1
        .Add twn, n
        Ray(n, 1) = Dn: Ray(n, 1) = Dn.Offset(, 1)
        Ray(n, Col) = Dn.Offset(, 1)  '<----Subscript out of range error
    Else
        Ray(.Item(twn), Col) = Dn.Offset(, 2)
    End If
Next
c = .Count
End With
With Range("F1")
.Resize(, 3) = Array("ID", "DOH", "SenDate")
.Offset(1).Resize(c, 3) = Ray
End With
End Sub

Answer 1

Вот подход VBA, если вы заинтересованы. Это работает путем циклического перебора столбца идентификатора, чтобы определить наличие изменений, а затем добавления элемента в массив для вывода в правильном формате.

Public Sub TransformData()
    Dim IDs     As Range
    Dim ID      As Range
    Dim ws      As Worksheet
    Dim Output  As Variant
    Dim i       As Long
    Dim PrevID  As String

    Set ws = ThisWorkbook.Sheets("Sheet1") ' adjust as needed
    Set IDs = ws.Range("A2:A9") 'Specify range to scan
    ReDim Output(1 To 3, 1 To 5000) 'Create an array large enough

    'Loop through each ID
    For Each ID In IDs
        i = i + 1
        'When the id is the same, this is the seniority row, assuming seniority appears after DateHired
        If ID = PrevID Then
            i = i - 1
            Output(3, i) = ID.Offset(0, 2) 'Update 3rd element     
        Else
            Output(1, i) = ID
            Output(2, i) = ID.Offset(0, 2)
        End If
        PrevID = ID
    Next

    'Output data
    ReDim Preserve Output(1 To 3, 1 To i)
    ws.Range("E1:G1") = Array("ID", "Date Hired", "Sen Date")
    ws.Range("E2:G" & UBound(Output, 2) + 1) = Application.Transpose(Output)
End Sub