在EXCEL表格中，数据有多达20万条，办公电脑基本无法处理。最近有个同事遇到了，而且以后基本每天都要处理，用VBA编写宏命令解决。刚开始写的简单，效率并不高，同事说每天要处理近20个文件。必须要优化程序，下面是优化后程序（部分）

具体功能：打开excel表格，读取内容（假定Sheet1中A列为身份证号、B列为数学成绩、C列为语文成绩、D列为成绩合计、E列是姓名），仅获取身份证号码前6为是“510700”、总成绩低于120分、且语文数据成绩都低于60分的记录。

Sub A大数据处理()

Dim tmpWorkBook As Workbook

Dim tmpWS1 As Worksheet ' 数据工作表（Sheet1）

Dim tmpWS2 As Worksheet ' 结果工作表（Sheet1）

Dim ShuJu As Variant ' 存储源数据的数组（内存操作）

Dim JieGuo As Variant ' 存储筛选结果的数组

Dim tmpI, tmpJ, tmpK As Long

Dim tmpStr As String

Application.Cursor = xlWait

' 优化效率用的，禁用Excel耗时功能

Application.ScreenUpdating = False ' 关闭屏幕更新

Application.Calculation = xlCalculationManual ' 关闭自动计算

Application.EnableEvents = False ' 关闭事件触发

Set tmpWS2 = Sheet1

tmpWS2.UsedRange.ClearContents

tmpWS2.Range("A1:E1").Value = Array("身份证号", "数学成绩", "语文成绩", "成绩合计", "姓名")

tmpStr = "D:\数据.xlsx"

Set tmpWorkBook = Workbooks.Open(Filename:=tmpStr, ReadOnly:=True) ' 只读打开，提升速度

Set tmpWS1 = tmpWorkBook.Worksheets("Sheet1")

ShuJu = tmpWS1.UsedRange.Value ' 读取源数据到数组，这个是高效处理的重要点

tmpJ = UBound(ShuJu, 1)

ReDim JieGuo(1 To tmpJ, 1 To 5)

tmpK = 0

For tmpI = 2 To tmpJ '有表头，从第2行开始

If Left(ShuJu(tmpI, 1), 6) = "510700" And ShuJu(tmpI, 4) < 120 And ShuJu(tmpI, 2) < 60 And ShuJu(tmpI, 3) < 60 Then

' 找到符合条件的数据

tmpK = tmpK + 1

JieGuo(tmpK, 1) = ShuJu(tmpI, 1)

JieGuo(tmpK, 2) = ShuJu(tmpI, 2)

JieGuo(tmpK, 3) = ShuJu(tmpI, 3)

JieGuo(tmpK, 4) = ShuJu(tmpI, 4)

JieGuo(tmpK, 5) = ShuJu(tmpI, 5)

End If

Next

tmpWS2.Range("A2").Resize(tmpK, 5).Value = JieGuo

tmpWorkBook.Close SaveChanges:=False

Set tmpWS1 = Nothing

Set tmpWS2 = Nothing

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

Application.EnableEvents = True

MsgBox "已获取符合条件的记录！", vbInformation, "提示"

Application.Cursor = xlDefault

End Sub