将多行合并为一，同时将其列值转换为单行

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