vba open 事件

ME.李

代码如下  现在open事件影响代码运行速度 请问有其他办法代替这个打开这个动作吗


Sub 导入数据()
Dim t, s
Application.ScreenUpdating = False
s = Timer
Set t = Application.FileDialog(msoFileDialogFilePicker)
t.AllowMultiSelect = False
If t.Show = -1 Then  '对话框选择确定返回-1
   For Each Kselecteditem In t.SelectedItems
      dz = Kselecteditem
      Set wb = Excel.Workbooks.Open(dz）
      arr = wb.Sheets(1).UsedRange
      wb.Close False
    Next
    N = Sheet1.Cells(Rows.Count, 2).End(3).Row
    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    For i = 2 To UBound(arr)
     m = m + 1
   brr(m, 1) = Val(arr(i, 1))
   brr(m, 2) = arr(i, 2)
   brr(m, 3) = arr(i, 3)
   brr(m, 4) = arr(i, 4)
  Next
    Sheet1.Cells(N + 1, "A").Resize(UBound(brr), UBound(brr, 2)) = brr
    MsgBox "提取完毕" & "耗时" & Round(Timer - s, 4) & "秒"   
    End If
End Sub

shiruiqiang

数据量大或者工作簿大的话，sql相对快一点

yes_cn

Sub 导入数据()
    Dim t, s, conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sql As String
    Dim dz As String
    Dim arr As Variant
    Dim brr As Variant
    Dim i As Long, m As Long, N As Long

    Application.ScreenUpdating = False
    s = Timer

    Set t = Application.FileDialog(msoFileDialogFilePicker)
    t.AllowMultiSelect = False

    If t.Show = -1 Then
        dz = t.SelectedItems(1)

        ' 使用ADODB连接读取Excel文件
        Set conn = New ADODB.Connection
        conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dz & ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

        sql = "SELECT * FROM [Sheet1$]"
        Set rs = conn.Execute(sql)

        ' 将数据读入数组
        arr = rs.GetRows
        arr = Application.Transpose(arr)

        rs.Close
        conn.Close

        N = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
        ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))

        For i = 2 To UBound(arr)
            m = m + 1
            brr(m, 1) = Val(arr(i, 1))
            brr(m, 2) = arr(i, 2)
            brr(m, 3) = arr(i, 3)
            brr(m, 4) = arr(i, 4)
        Next i

        Sheet1.Cells(N + 1, "A").Resize(UBound(brr), UBound(brr, 2)) = brr
        MsgBox "提取完毕" & "耗时" & Round(Timer - s, 4) & "秒"
    End If
End Sub


如果文件格式允许，还可考虑使用文本文件导入

taller

ME.李

taller 发表于 2024-9-7 04:52

测试了下  显示时间还是比不加这个系统事件 快不了多少 有时候还没有open快

ME.李

yes_cn 发表于 2024-9-6 22:02
Sub 导入数据()
    Dim t, s, conn As ADODB.Connection
    Dim rs As ADODB.Recordset

谢谢大佬 我也是这样改得 1楼朋友说了后