excel - 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