最近有个朋友要处理很多的Excel数据，但是手工处理又太慢，让我帮忙处理。通过搜索和自己的编写，帮他写了几个脚本，大大提高了工作效率。其实Excel中的脚本（宏）的功能非常方便，只要熟悉了Excel的对象，做一些常见的处理，还是非常容易的。
根据Sheet2中的数据，检查Sheet1中的重复数据，并且进行后续的操作（将重复数据删除或者拷贝出来）的操作。
‘2010-12-22 使用Application.ScreenUpdating
Application.ScreenUpdating = False C = 2 ‘第一个工作表检测B列 X = 1 ‘第一条检测结果放在第1行 Count = 1 First_sheet_row = Sheets(1).Cells(65536, C).End(xlUp).Row Second_sheet_row = Sheets(2).Cells(65536, C).End(xlUp).Row Dim To_be_deleted(5369) As String
For j = 1 To 5368 To_be_deleted(j) = Trim(CStr(Sheets(2).Cells(j, 2).Value)) Next j
For i = 1 To First_sheet_row First_value = Trim(CStr(Sheets(1).Cells(i, C).Value)) For j = 1 To 5368 ‘MsgBox To_be_deleted(j) If First_value = To_be_deleted(j) Then Sheets(1).Range(“A” & CStr(i) & “:Ag” & i).Delete Sheets(2).Cells(j, 4).Value = “Copied” ‘Sheets(2).Cells(j, 3).Value = “Copied” ‘Application.CutCopyMode = False ‘Sheets(1).Range(“A” & CStr(i) & “:Ag” & i).Copy ‘Sheets(3).Paste Destination:=Sheets(3).Range(“A” & i) ‘Sheets(3).Paste Count = Count + 1 i = i – 1 End If Next j Next i Application.ScreenUpdating = True MsgBox “共删除了” & Count
这个脚本中有一些优化的地方，原来进行数据比较时，都是使用直接Cell(x,y)的方式访问并对比，另外也是分别循环，效率非常低，Excel一直处于假死的状态。
后来，先将比较小的一份数据拷贝到数组中，然后再进行循环，这样效率就提高了很多。
合并目录中具有同样数据格式的多个Excel文件
Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & “\” & “*.xls”) AWbName = ActiveWorkbook.Name Num = 0 Do While MyName <> “” If MyName <> AWbName Then Set Wb = Workbooks.Open(MyPath & “\” & MyName) Num = Num + 1 With Workbooks(1).ActiveSheet .Cells(.Range(“A65536”).End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) – 4) For G = 1 To Sheets.Count Wb.Sheets(G).UsedRange.Copy .Cells(.Range(“A65536”).End(xlUp).Row + 1, 1) Next WbN = WbN & Chr(13) & Wb.Name Wb.Close False End With End If MyName = Dir Loop Range(“A1”).Select Application.ScreenUpdating = True MsgBox “共合并了” & Num & “个工作薄下的全部工作表。如下：” & Chr(13) & WbN, vbInformation, “提示”
合并一个文件中的多个Sheet
Application.ScreenUpdating = False For j = 1 To Sheets.Count If Sheets(j).Name <> ActiveSheet.Name Then X = Range(“A65536”).End(xlUp).Row + 1 Sheets(j).UsedRange.Copy Cells(X, 1) End If Next Range(“A1”).Select Application.ScreenUpdating = True MsgBox “当前工作簿下的全部工作表已经合并完毕！”, vbInformation, “提示”
利用编程，可以让我们的生活更美好~~
有事者，事竟成;破釜沉舟，百二秦关终归楚;苦心人，
