Excel表格提取数据到同一行上面
1、打开Excel表格之后，依次点击【开发工具】、【Visual Basic】，或者按下键盘上面的【Alt+F11】组合键调出VBA编辑器。
2、在VBA编辑器的菜单栏上面依次点击【插入】、【模块】。
3、在模块的代码框里面输入以下VBA程序代码，然后再按【F5】键运行VBA程序。
（Sheet2工作表需是空白的，以免里面的数据被删除）
Sub Tiqushuju()
Dim i1, i2, i3, i4, i5
On Error Resume Next '忽略运行过程中可能出现的报警提示
Application.DisplayAlerts = False '屏蔽报警提示
Set mysheet1 = ThisWorkbook.Worksheets("Sheet1") '定义工作表Sheet1
Set mysheet2 = ThisWorkbook.Worksheets("Sheet2")
mysheet1.Columns("A:A").Copy '复制工作表Sheet1里面的A列
mysheet2.Select
mysheet2.Cells(1, 1).Select
ActiveSheet.Paste '把工作表Sheet1里面的A列粘贴到Sheet2上面的A列
mysheet2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo '删除重复项
mysheet2.Columns("A:A").Copy
mysheet1.Select
mysheet1.Cells(1, 4).Select
ActiveSheet.Paste '把工作表Sheet2里面的A列粘贴到Sheet2上面的D列
Application.CutCopyMode = False
mysheet1.Cells(1, 4).Select
For i1 = 2 To 10000
If mysheet1.Cells(i1, 4) <> "" Then
i2 = Application.WorksheetFunction.CountIf(mysheet1.Range("A2:A10000"), _
mysheet1.Cells(i1, 4)) '统计A列里面与D列单元格存在相同单元格的个数
i4 = 0
i5 = 1 '从第1行开始
For i3 = 1 To i2 '按照存在相同个数执行相应的次数
i4 = Application.WorksheetFunction.Match(mysheet1.Cells(i1, 4), _
mysheet1.Range(mysheet1.Cells(i5, 1), mysheet1.Cells(10000, 1)), 0)
'获取该单元格所在A列的位置
i5 = i5 + i4 '在原来第几行的基础上递增
mysheet1.Cells(i1, i3 + 4) = mysheet1.Cells(i5 - 1, 2)
Next
End If
Next
End Sub
4、在程序运行之后，回到Excel工作表界面，将会看到其执行结果。
5、VBA程序释义说明：
（1）提取不重复的数据项，在觉得使用VBA程序较为麻烦的情况下，可以通过手工提取，这样的程序也会变得简洁很多，几行代码就搞定。即：把需要的数据复制到空白的表格上面，删除重复项之后再把它复制、粘贴过来。
6、VBA程序释义说明：
（2）在程序里面借用到了Excel函数的Countif和Match。Countif主要是用来求解存在相同单元格的个数，Match则用来求解满足条件的单元格所在的位置，两者结合使用，可以有效的减少程序的运行时间。
打个简单的比喻，如果使用If逐一去判断，对应得上是数据则选出来，对于上万的数据来说，那它就要执行上亿次的数据比对，这样就耗费了很多时间。当然，初学VBA，又想不到捷径的情况下可以采用此法，后面再进行修正。
