根据列A将数据移动到1行，从列D移动数据和时间

Question

我认为这张照片应该告诉你我想要实现的目标。

我仍然可以尝试解释一下。

我在顶级表5列A B C D E

A列是主要的，它包含Num，其中包含个别数字的记录，最多可包含8条记录。

我需要将所有记录放在NUM行的一行中。

按A和D排序。

我只需根据发生的时间移动C列。

我刚添加了额外的列，因为我最多可以有8个Non Created和最多4个Cause Created记录。

Answer 1

我假设接下来

1. 表一在Sheet中名为“Input”
2. 输出将在Sheet中生成，名为“output”，已经有标题

将此代码粘贴到模块中并运行它

Option Explicit

Sub Sample()
    Dim wsInput As Worksheet, wsOutput As Worksheet
    Dim wsILrow As Long, wsOLrow As Long, i As Long, c As Long, nc As Long
    Dim wsIrng As Range, fltrdRng As Range, cl As Range
    Dim col As New Collection
    Dim itm

    Set wsInput = Sheets("Input")
    Set wsOutput = Sheets("Output")

    With wsInput
        wsILrow = .Range("A" & .Rows.Count).End(xlUp).Row

        Set wsIrng = .Range("A1:E" & wsILrow)

        With wsIrng
            .Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range("D2") _
            , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
            , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
            xlSortNormal
        End With

        For i = 2 To wsILrow
            On Error Resume Next
            col.Add .Cells(i, 1).Value, Chr(34) & .Cells(i, 1).Value & Chr(34)
            On Error GoTo 0
        Next i
    End With

    wsOLrow = 2

    With wsOutput
        For Each itm In col
            .Cells(wsOLrow, 1).Value = itm
            wsOLrow = wsOLrow + 1
        Next

        wsOLrow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 2 To wsOLrow
            With wsInput
                '~~> Remove any filters
                .AutoFilterMode = False

                With wsIrng '<~~ Filter, offset(to exclude headers)
                    .AutoFilter Field:=1, Criteria1:=wsOutput.Cells(i, 1).Value
                    Set fltrdRng = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
                End With

                '~~> Remove any filters
                .AutoFilterMode = False
            End With

            '<~~ c is for Cause column and nc is for non cause
            c = 3: nc = 7

            For Each cl In fltrdRng.Cells
                If cl.Column = 3 And Len(Trim(cl.Value)) <> 0 Then
                    If InStr(1, cl.Value, "Cause", vbTextCompare) Then
                        .Cells(i, c).Value = wsInput.Cells(cl.Row, 3).Value
                        c = c + 1
                    ElseIf InStr(1, cl.Value, "Non", vbTextCompare) Then
                        .Cells(i, nc).Value = wsInput.Cells(cl.Row, 3).Value
                        nc = nc + 1
                    End If

                    .Cells(i, 2).Value = wsInput.Cells(cl.Row, 2).Value
                    .Cells(i, 15).Value = wsInput.Cells(cl.Row, 5).Value
                End If
            Next
        Next i
    End With
End Sub

<强>截图

输入表



输出表



注意：结构的任何未来更改都必须包含在代码中。