VBA 循环永远存在 - 我在哪里可以优化？

Question

我编写了以下代码，以便对已关闭工作簿中的指定列求和。

我的汇总表在 B 列中包含文件位置/名称，在 C 列中求和列位置，在 D 列中将列字母转换为数字，然后在 E 列中包含总金额。

我目前有大约 50 个工作簿需要从中提取数据，因此我创建了一个循环，首先测试文件是否存在（文件名每天更改并且每天在不同时间可用），如果文件存在，然后它打开工作簿并对该工作簿的指定列求和，将该总和放在摘要表 E 列中，然后关闭工作簿，然后移动到下一行。运行需要一段时间，而且由于你们中的很多人在编码方面比我要好得多，我想知道是否/如何让这个运行更优化。非常感谢任何帮助。

这是我当前的代码：

Sub GetClosedPNL2()

    Application.ScreenUpdating = False

    Dim wbBook1 As Workbook: Set wbBook1 = ThisWorkbook
    Dim src As Workbook
    Dim lCol As Integer
    Dim LastRow As Long
    Dim DataRange As Range
    Dim Cll As Range
    Dim strFileName As String
    Dim strFileExists As String
       
    LastRow = Sheets("AccountMap").Cells(Sheets("AccountMap").Rows.Count, "B").End(xlUp).Row
    Set DataRange = Sheets("AccountMap").Range("B2:B" & LastRow)

    For Each Cll In DataRange
        strFileName = (Cll.Value)
        strFileExists = Dir(strFileName)
    
        If strFileExists = "" Then 
            GoTo Line2 
        Else 
            GoTo Line1
    
Line1:
        Set src = Workbooks.Open(Cll.Value, ReadOnly:=True)
        lCol = Cll.Offset(0, 2).Value
        Cll.Offset(0, 3) = Application.Sum(src.Sheets(1).Columns(lCol))
        src.Close False
        Set src = Nothing
    
Line2:
    Next Cll

End Sub

Answer 1

将列的总和复制到另一个工作簿

• 您知道Columns 也适用于字符串吗？这些都是一样的：

  Columns(1)
  Columns("A")
  

• 请注意，如果单元格包含错误值，Application.Sum 将引发错误。

• 通常最好用消息框结束代码，以通知代码已完成。将其放在Application.ScreenUpdating = True 之后，以便立即注意到后台（工作表）中的更改（如果有）。

流程

• Data 是 B:E 列中的范围写入的数组。数组（范围）第一列中的每个文件路径都用于检查文件是否存在。如果是，则打开它，将所需的总和写入第一列，然后关闭文件。如果不存在，则将第四列中的值写入第一列。在这两种情况下，当前文件路径都会被覆盖。最后，只有第一列写入工作表中的列E。

代码（未测试）

Option Explicit

Sub GetClosedPNL2()

    Dim DataRange As Range
    Dim LastRow As Long
    With ThisWorkbook.Worksheets("AccountMap")
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set DataRange = .Range("B2:B" & LastRow) ' "B"
    End With
    
    Dim Data As Variant: Data = DataRange.Resize(, 4).Value ' "B:E"
    
    Application.ScreenUpdating = False
    
    Dim FileName As String
    For i = 1 To UBound(Data, 1)
        FileName = Dir(Data(i, 1))
        If Len(FileName) > 0 Then
            Application.DisplayAlerts = False
            With Workbooks.Open(Data(i, 1), ReadOnly:=True)
                Data(i, 1) = Application.Sum(.Worksheets(1).Columns(Data(i, 3)))
                .Close SaveChanges:=False
            End With
            Application.DisplayAlerts = True
        Else
            Data(i, 1) = Data(i, 4)
        End If
    Next i
    
    ' Redim Preserve Data(1 To UBound(Data, 1), 1 to 1) ' Not nesessary.
    DataRange.Offset(, 3).Value = Data ' "E"
    
    Application.ScreenUpdating = True

    MsgBox "Sum column updatad.", vbInformation, "Success"

End Sub