我需要在Excel表格中取2列,并将它们转换为数据范围,第1列作为标题

在Excel中我有一些数据如下。 他们在2列作为一个列表。 左栏有员工姓名,第二栏是时间/电脑。

Employee Time/pc TE 0.616438356 TE 0.581896552 FL 0.474040632 AD 0.473251029 AD 0.491803279 TE 0.616438356 TE 0.652173913 TE 0.575 CG 0.744680851 JU 0.784313725 JU 0.568181818 JU 0.709459459 JU 0.227272727 AD 0.461956522 AD 0.555555556 JU 0.014285714 JU 0.692307692 

我需要轻松地将其转换为第一列用作标题的范围,我需要删除重复项。 然后它需要列出每个名称旁边的所有值。

谁能帮我?

我对VBA相当陌生,但我试图回答问题来支持社区。 我欢迎任何/所有更正此代码,但我testing了它。 它的工作原理和它所要求的一样。 然而,它不以任何方式,形状或forms进行优化。

我调用了初始表“RawData”和新表“NewData”

 Option Explicit Sub Pivot() Dim i, m, q As Integer i = 2 q = 3 Do While Sheets("RawData").Cells(i, 1).Value <> "" If Sheets("NewData").Range("A1:ZZ1").Find(Sheets("RawData").Cells(i, 1), LookAT:=xlWhole) Is Nothing Then If Sheets("NewData").Range("A1") <> "" Then If Sheets("NewData").Range("B1") <> "" Then Worksheets("RawData").Cells(i, 1).Copy Worksheets("NewData").Activate Cells(1, q).Activate ActiveCell.PasteSpecial xlPasteValues Worksheets("RawData").Cells(i, 2).Copy Worksheets("NewData").Activate Cells(2, q).Activate ActiveCell.PasteSpecial xlPasteValues q = q + 1 Else Worksheets("RawData").Cells(i, 1).Copy Worksheets("NewData").Activate Range("B1").Activate m = ActiveCell.Column ActiveCell.PasteSpecial xlPasteValues Worksheets("RawData").Cells(i, 2).Copy Worksheets("NewData").Activate Cells(2, m).Activate ActiveCell.PasteSpecial xlPasteValues End If Else Worksheets("RawData").Cells(i, 1).Copy Worksheets("NewData").Activate Range("A1").Activate m = ActiveCell.Column ActiveCell.PasteSpecial xlPasteValues Worksheets("RawData").Cells(i, 2).Copy Worksheets("NewData").Activate Cells(2, m).Activate ActiveCell.PasteSpecial xlPasteValues End If Else Worksheets("RawData").Cells(i, 2).Copy Worksheets("NewData").Activate Sheets("NewData").Range("A1:ZZ1").Find(Sheets("RawData").Cells(i, 1), LookAT:=xlWhole).Activate m = ActiveCell.Column Worksheets("NewData").Cells(1, m).End(xlDown).Offset(1, 0).Activate ActiveCell.PasteSpecial xlPasteValues End If i = i + 1 Loop End Sub 

检查下面的代码,它会帮助你得到期望的结果。 艾米莉·奥尔登(Emily Alden)发布的代码也可以工作。 这是更短的方式。

 Sub test() Dim raw_data, new_data As Worksheet Dim new_col_num, data_row_num, i As Long Dim employee, time As String Dim rng As Range data_row_num = 1 new_col_num = 1 Set raw_data = ThisWorkbook.Sheets("raw_data") Set new_data = ThisWorkbook.Sheets("new_data") Do Until raw_data.Cells(data_row_num, 1).Value = "" employee = raw_data.Cells(data_row_num, 1).Value time = raw_data.Cells(data_row_num, 2).Value new_data.Range("A1").Activate Set rng = new_data.Range("A1:XFD1").Find(what:=employee, LookIn:=xlValues, LookAt:=xlWhole, searchorder:=xlByColumns) If rng Is Nothing Then new_data.Cells(1, new_col_num).Value = employee new_data.Cells(2, new_col_num).Value = time new_col_num = new_col_num + 1 data_row_num = data_row_num + 1 Else i = new_data.Cells(1, rng.Column).End(xlDown).Row + 1 new_data.Cells(i, rng.Column).Value = time data_row_num = data_row_num + 1 End If Loop End Sub