如何优化一下这些代码。让它运行更快？？

liw0311041

由于文件过大无法上传。。
效果需求：
1、在C列单元格输入编码后点击D列读取数据有时候很慢，
2、点击“保存订单”按钮执行到清除数据那步也会很慢。
如何优化一下让它更快不卡呢？？
4、如何通过点击“查询订单”来实现以输入的单号来读取ACCSSER中所有相同单号的数据显示在相应的单元格？？？
sheet1代码1：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim rst As New ADODB.Recordset
        Dim txt As String
    If Target.Column = 4 And Target.Row > 1 And ActiveSheet.Cells(Target.Row, 3) <> "" Then '4是数据开始放的第一个位置；3是引用列的数据
        txt = "select * from 配件信息库 where 型号编码='" & ActiveSheet.Cells(Target.Row, 3) & "'" '是数据中的位置；3是引用列的数据
        rst.Open txt, cnn, 1, 3
        ii = rst.RecordCount
        If rst.RecordCount = 1 Then
            For i = 1 To rst.Fields.Count - 1
                ActiveSheet.Cells(Target.Row, i + 3) = rst.Fields(i)
            Next
        End If
        rst.Close
        cnn.Close
    End If
End Sub
模块1：
'引用Microsoft ActiveX Data Objects 2.x Library
Sub 录入数据删除()
    Dim cnn As New ADODB.Connection
    Dim myPath As String
    Dim myTable As String
    Dim SQL As String
    myPath = ThisWorkbook.Path & "\Info.mdb"
    myTable = "信息"
    On Error GoTo errmsg
    cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & myPath '连接数据库
    SQL = "select #" & [d1] & "# as 发货日期," & [f1] & " as 月份," & [h1] & " as 周数,'" & [j1] & "' as 星期,'" & [d2] & "' as 收货单位,'" & [f2] & "' as 发货人,'" & [K2] & "' as 颜色类,'" & [L1] & "' as 单号,'" & [i2] _
        & "' as 交货日期,* from [Excel 12.0;Database=" & ActiveWorkbook.FullName & "].[" & ActiveSheet.Name & "$C3:R" & Range("c" & Rows.Count).End(xlUp).Row & "]"
    SQL = "insert into " & myTable & " " & SQL '插入新记录SQL语句
    cnn.Execute SQL
    MsgBox "数据已保存！请在“马克订单查询管理系统V6.05”中查看或修改！", vbInformation, "添加数据"
    cnn.Close
    Set cnn = Nothing
    Range("D2,F2,K2,i2,L1,C4:H25").Select
    Range("D2").Activate
    Selection.ClearContents
    Range("D2").Select
    Exit Sub
errmsg:
    MsgBox Err.Description, , "错误报告"
End Sub
模块2：
Public Function cnn() As ADODB.Connection            '定义数据库连接函数

    Set cnn = New ADODB.Connection
cnn.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\数据库1.accdb"
End Function

liw0311041

查询页面也可以独立做一个工作表来实现。