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

我觉得这张照片几乎可以告诉你我想要达到什么目的。

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

我在桌面上有5列ABCDE

A列是主要的，它包含Num个人号码logging，最多可以有8条logging。

我需要把所有的logging放在NUM的1行。

它由A和Dsorting

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

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

Answer 1

我正在假设

1. 表一在名为“input”的工作表中
2. 输出将在名为“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 

截图

input表

输出表

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