excel - 根据 A 列和 D 列的数据和时间将单元格移动到 1 行

Question

我认为这张照片应该可以告诉你我想要达到的目标。

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

我在顶部表 5 列 ABCDE

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

我需要将所有记录按 NUM 放在 1 行中。

它按 A 和 D 排序。

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

我刚刚添加了额外的列，因为我最多可以有 8 个非创建记录和最多 4 个原因创建记录。

Answer 1

我假设以下情况

1. 表一在名为“输入”的工作表中
2. 输出将在名为“输出”的工作表中生成，该工作表已经有标题

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

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

截屏

输入表

输出表

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