Объедините несколько строк в одну, перенеся значение столбца в одну строку.

Question

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

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

Public Sub extractUniques(rngSource As Range, rngTarget As Range)

Application.ScreenUpdating = False

    rngSource.AdvancedFilter Action:=xlFilterCopy, _
        copytorange:=rngTarget, Unique:=True

Application.ScreenUpdating = True

End Sub

Answer 1

Попробуйте!

Sub specialTransfer()
    Dim inp As Range, outp As Range, rng As Range, c As Range, data(), u, r, x, i, j

    Set inp = [A1] 'Change this to the top left cell of your input
    Set outp = [F1] 'Change this to the top left cell of your output
    Set rng = Range(inp.Offset(1, 1), Cells(Rows.Count, 2).End(xlUp))

    data = rng.Value

    Set u = CreateObject("Scripting.Dictionary")
    For r = 1 To UBound(data)
        u(data(r, 1)) = Empty
    Next r
    x = u.Keys()

    'Option to clear out everything past the outputcell
    'Range(outp, Cells(Rows.Count, Columns.Count)).ClearContents

    outp = "Name"
    For i = 0 To u.Count - 1
        j = 1
        outp.Offset(i + 1) = x(i)
        For Each c In rng
            Range(outp.Offset(, j), outp.Offset(, j + 2)) = Array("Day", "Time out", "Time in")
            If WorksheetFunction.CountA(c.Offset(, -1).Resize(, 4)) = 4 Then
                If c = x(i) Then
                    outp.Offset(i + 1, j).Value = Format(Mid(c.Offset(, -1), 4, 10), "General Number")
                    outp.Offset(i + 1, j + 1).Value = Format(c.Offset(, 1), "h:mm AM/PM")
                    outp.Offset(i + 1, j + 2).Value = Format(c.Offset(, 2), "h:mm AM/PM")
                    j = j + 3
                End If
            End If
        Next c
    Next i
End Sub