Question

我有一个大约70-80列的Excel文件。我需要获取每列的最小值和最大值。我还需要Access上的最小值和最大值。我为Access和Excel编写了代码，宏的速度在两者中都非常不同。两者都有点不同但很相似。

这是Excel代码：

Public Sub MinAndMax()
  Dim i As Long, j As Long
  Dim usedTime As Double
  usedTime = Timer

  Dim nbCol As Long, nbRow As Long
  nbCol = Range("A1").End(xlToRight).Column
  nbRow = Range("A1").End(xlDown).Row

  Dim min As Double, max As Double
  Dim temp As Variant

  'First column is for the table key
  'First row is for table header

  For j = 2 To nbCol
    min = Cells(2, j)
    max = Cells(2, j)

    For i = 3 To nbRow
      temp = Cells(i, j)

      If IsNumeric(temp) Then
        If temp > max Then max = temp
        If temp < max Then min = temp
      End If
    Next i
  Next j

  MsgBox "Time : " Round(Timer - duree) " seconds."
End Sub

Excel上大约需要5秒钟。

在Access上，它现在是一个返回数组的函数，带有一个选项，指示您是否希望每个列的数组都包含max或min。所以为了获得最小值和最大值，我必须调用它两次。

Private Function GetMinAndMax_Access(Optional ByVal getMin As Boolean = False) As Double()
  Dim Path As String
  Path = "C:\File.xlsx"

  Dim appExcel As Excel.Application
  Set appExcel = CreateObject("Excel.Application")

  appExcel.ScreenUpdating = False

  Dim wb As Workbook
  Set wb = appExcel.Workbooks.Open(Path)

  Dim ws As Worksheet
  Set ws = wb.Worksheets(1)

  Dim nbCol As Long, nbRow As Long
  nbCol = ws.Range("A1").End(xlToRight).Column
  nbRow = ws.Range("A1").End(xlDown).Row    

  ReDim extremum(2 To nbCol) As Double

  Dim temp As Variant

  Dim i As Long, j As Long 'Again, data start at row 2, column 2

  For j = 2 To nbCol
    extremum(j) = ws.Cells(2, j)

    For i = 3 To nbRow
      temp = ws.Cells(i, j)

      If IsNumeric(temp) Then
        If getMin Then
          If temp < extremum(j) Then extremum(j) = temp
        Else
          If temp > extremum(j) Then extremum(j) = temp
        End If
      End If
    Next i
  Next j

  GetMinAndMax_Access = extremum

  appExcel.ScreenUpdating = True

  wb.Close SaveChanges:=False
  appExcel.Quit
End Function

在同一数据集上执行此操作仅需29分钟。请注意，我调用了两次函数，一次是最小值，一次是最大值。

任何想法为什么Access和Excel之间的速度如此不同，以及可以做些什么呢？这对我来说似乎很奇怪！

Answer 1

似乎有点长篇大论，可以从列中获取最小和最大数值。工作表函数MIN和MAX的速度相当快：

在Excel中：

Public Sub MinAndMax()

    Dim rLastCell As Range
    Dim x As Long
    Dim colMinMax As Collection

    Set rLastCell = Cells.Find(What:="*", After:=Cells(1, 1), SearchDirection:=xlPrevious)

    If Not rLastCell Is Nothing Then
        Set colMinMax = New Collection
        For x = 1 To rLastCell.Column
            colMinMax.Add Array(Application.WorksheetFunction.min(Columns(x)), _
                                Application.WorksheetFunction.max(Columns(x)))
        Next x
    End If

End Sub

在Access中（使用后期绑定，因此无需设置引用）：

Sub ToUse()

    Dim MyCol As Collection
    Set MyCol = New Collection

    Set MyCol = GetMinMax("C:\Documents and Settings\crladmin.ADMINNOT\My Documents\MinMax.xlsm", "Sheet1")

End Sub

Private Function GetMinMax(sPath As String, sSheet As String) As Collection

    Dim oXL As Object
    Dim oWB As Object
    Dim oWS As Object

    Dim rLastCell As Object
    Dim x As Long
    Dim colMinMax As Collection

    Set oXL = CreateXL
    Set oWB = oXL.Workbooks.Open(sPath, False)
    Set oWS = oWB.Worksheets(sSheet)

    Set rLastCell = oWS.Cells.Find(What:="*", After:=oWS.Cells(1, 1), SearchDirection:=2) '2 = xlPrevious
    If Not rLastCell Is Nothing Then
        Set colMinMax = New Collection
        For x = 1 To rLastCell.Column
            colMinMax.Add Array(oXL.WorksheetFunction.min(oWS.Columns(x)), _
                                oXL.WorksheetFunction.max(oWS.Columns(x)))
        Next x
    End If

End Function

Public Function CreateXL(Optional bVisible As Boolean = True) As Object

    Dim oTmpXL As Object

    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Defer error trapping in case Excel is not running. '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    Set oTmpXL = GetObject(, "Excel.Application")

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'If an error occurs then create an instance of Excel. '
    'Reinstate error handling.                            '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo ERROR_HANDLER
        Set oTmpXL = CreateObject("Excel.Application")
    End If

    oTmpXL.Visible = bVisible
    Set CreateXL = oTmpXL

    On Error GoTo 0
    Exit Function

ERROR_HANDLER:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure CreateXL."
            Err.Clear
    End Select

End Function

两个程序都将返回包含MIN＆amp; amp;的二维数组的集合。每列的MAX值：项目1（0） - 4
项目1（1） - 98
项目2（0） - 3
项目2（1） - 15

Excel和Access之间的VBA执行速度不同

1 个答案: