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