VBA 按条件筛选数据库记录导出Excel（如何加快写入速度）

你这样循环查询是不科学了，上万记录会慢死，应该一次性读出所有数据，然后去填写：

'建立已经字典，把数据库内容存入字典

set daList = CreateObject("Scripting.Dictionary")

rs.Open "select DA,B1,S1,M1,St1,R1 from `A`", conn

Do While Not rs.EOF()

     daList.Add rs(1), Array(rs(2),rs(3),rs(4),rs(5),rs(6))

     rs.MoveNext

Loop

'填写EXCEL表

for i=2 to Cells(rows.count, "D").End(xlUp).Row

    da = Cells(i,"D")

    if daList.Exists(da) then

        Cells(i,"E").resize(5,1) = daList(da)

    else

        Cells(i,"E").resize(5,1) = Empty

    end if

next i

Dim i, j, k As Integer

k = 1 'k赋初值

i = InputBox("please input the item num:") '给出总行数信息

For j = 1 To i '循环判断

If Sheets("sheet1").Cells(j, 5).Text = 1 Then '如果第5列的值等于1

Sheets("sheet1").Select

Range(Cells(j, 1), Cells(j, 5)).Select '选中表1中前五列数据

Selection.Copy '复制

Sheets("Sheet2").Select '选中表2

Range(Cells(k, 1), Cells(k, 5)).Select '选中表2的前5列

ActiveSheet.Paste Link:=True '粘贴链接

k = k + 1 '表2行号增加

End If

Next

Application.CutCopyMode = False '退出复制粘贴模式 这句和下面的语句为辅助语句可删

Cells(1, 1).Select需输入总行数，希望能帮到你。

---