从多列解析

Question

我有以下数据：

我需要找到一种解析数据并以某种单一格式输出的方法，例如：

它可以通过公式甚至数据透视表......或其他方法填充。 我尝试了一些方法但没有成功。

Answer 1

由于这是一种透视表，因此您应该取消它的旋转。最方便的方法是使用 Power Query ，这是Excel的原生部分已有一段时间了。如果您的Excel版本本身没有Power Query，您仍可以下载它并与Excel一起使用。

您可以直接从Power Query或Excel中打开数据，也可以使用数据|从表/范围菜单将数据发送到Power Query。

您可以在下面找到如何在Power Query中忽略数据：

Unpivot columns (Power Query)

取消隐身后，您可以关闭＆amp;加载按钮，再次为Excel提供最终数据。

Answer 2

假设表1是您的实际数据表和sheet2，您复制了已排序的数据;

1-如果＆＃34;日期＆＃34;，＆＃34;人＆＃34;，＆＃34;工作＆＃34;，＆＃34;任务＆＃34;是sheet2中的A，B，C，D列：

Sub Macro1()

Dim i, j, lr, lc, newlr, newlc As Long

lr = Sheets("Sheet1").Range("A2").End(xlDown).Row '' your last row
lc = Sheets("Sheet1").Range("A1").End(xlToRight).Column '' your last column

For j = 1 To lc
For i = 3 To lr

If InStr(Sheets("Sheet1").Cells(2, j).Value, "Job") Then

Sheets("Sheet1").Cells(i, j).Copy

Sheets("Sheet2").Select
Cells(1, 3).Select
newlr = Selection.End(xlDown).Row '' your new last row

Sheets("Sheet2").Cells(newlr + 1, 3).Paste

ElseIf InStr(Sheets("Sheet1").Cells(2, j).Value, "Date") Then

Sheets("Sheet1").Cells(i, j).Copy

Sheets("Sheet2").Select
Cells(1, 1).Select
newlr = Selection.End(xlDown).Row '' your new last row

Sheets("Sheet2").Cells(newlr + 1, 1).Paste

ElseIf InStr(Sheets("Sheet1").Cells(2, j).Value, "Person") Then

Sheets("Sheet1").Cells(i, j).Copy

Sheets("Sheet2").Select
Cells(1, 2).Select
newlr = Selection.End(xlDown).Row '' your new last row

Sheets("Sheet2").Cells(newlr + 1, 2).Paste

ElseIf InStr(Sheets("Sheet1").Cells(2, j).Value, "Task") Then

Sheets("Sheet1").Cells(i, j).Copy

Sheets("Sheet2").Select
Cells(1, 4).Select
newlr = Selection.End(xlDown).Row '' your new last row

Sheets("Sheet2").Cells(newlr + 1, 4).Paste

End If

Next
Next

End Sub

2-如果是＆＃34;日期＆＃34;，＆＃34;人＆＃34;，＆＃34;工作＆＃34;，＆＃34;任务＆＃34;那么不是sheet2中的当前列：

Sub Macro2()

Dim i, j, k, lr, lc, newlr, newlc As Long

lr = Sheets("Sheet1").Range("A2").End(xlDown).Row '' your last row
lc = Sheets("Sheet1").Range("A1").End(xlToRight).Column '' your last column

Sheets("Sheet2").Cells(1, 1).Value = "Date"
Sheets("Sheet2").Cells(1, 2).Value = "Person"
Sheets("Sheet2").Cells(1, 3).Value = "Job"
Sheets("Sheet2").Cells(1, 4).Value = "Task"

For k = 1 To 4
For j = 1 To lc
For i = 3 To lr

If InStr(Sheets("Sheet1").Cells(2, j).Value, Sheets("Hoja6").Cells(1, k).Value) Then

Sheets("Sheet1").Cells(i, j).Copy

Sheets("Sheet2").Select
Cells(1, k).Select
newlr = Selection.End(xlDown).Row '' your new last row

Sheets("Sheet2").Cells(newlr + 1, k).Paste


End If

Next
Next
Next

End Sub