Как рассчитать сумму для всех файлов в каталоге, когда их итерировать?

Question

Все файлы в каталоге survey содержат одинаковую структуру.
Данные в x1.xls:

Данные в x2.xls:

Я хочу получить сумму столбцов b и c для обоих x1.xls и x2.xsl.
Результат для x1.xls.

Та же сумма для x2.xls.
Я могу сделать с помощью следующих шагов:
1.Откройте редактор VB в x1.xls
2. Отредактируйте ниже sub и связать ctrl+z с sub sum.

Sub Sum()
    Dim BottomOfTable As Long
    BottomOfTable = Cells(Rows.Count, "A").End(xlUp).Row
    Cells(BottomOfTable + 1, "A").Value = "score"
    Range("B" & BottomOfTable + 1).Select
    Selection.FormulaR1C1 = "=round(SUM(R[-" & BottomOfTable - 1 & "]C:R[-1]C)" & ",2)"
    Selection.AutoFill Destination:=Range("b" & BottomOfTable + 1 & ":" & "c" & BottomOfTable + 1), Type:=xlFillDefault
    Range("b" & BottomOfTable + 1 & ":" & "c" & BottomOfTable + 1).Select    
End Sub

Различные файлы содержат разные строки, поэтому используйте Cells(Rows.Count, "A").End(xlUp).Row, чтобы получить динамические c строки для разных файлов.

3. Нажмите ctrl+z в x1.xls.
4. Откройте x2.xls и нажмите ctrl+z.

Теперь я хочу автоматизировать процесс с помощью vba.

Вот моя попытка:

Sub ListDir()
Dim FileName As String
Dim myPath as string
myPath="d:\survey\"
FileName = Dir(myPath, vbNormal)
Do While FileName <> ""
    targetFile =  myPath & FileName
    sumColumns(targetFile)
    FileName = Dir()
Loop
End Sub


Function sumColumns(targetFile)    
    Dim BottomOfTable As Long, AK As Workbook
    Set AK = Workbooks.Open(targetFile)
    BottomOfTable = AK.Cells(Rows.Count, "A").End(xlUp).Row
    Cells(BottomOfTable + 1, "A").Value = "score"
    Range("B" & BottomOfTable + 1).Select
    Selection.FormulaR1C1 = "=round(SUM(R[-" & BottomOfTable - 1 & "]C:R[-1]C)" & ",2)"
    Selection.AutoFill Destination:=Range("b" & BottomOfTable + 1 & ":" & "c" & BottomOfTable + 1), Type:=xlFillDefault
    Range("b" & BottomOfTable + 1 & ":" & "c" & BottomOfTable + 1).Select  
    AK.Close  
End Function

Когда я выполняю sub ListDir() x1.xsl в редакторе vba, возникает ошибка:

и, возможно, есть некоторые другие ошибки в функции sumColumns, как исправить, чтобы получить ожидаемую сумму результата для всех файлы в каталоге survey?

Answer 1

Этот код должен находиться в файле, отличном от того, который вы пытаетесь изменить.

Вы можете запустить его с помощью клавиши F8, чтобы сказать, что меняется между вашим кодом и моим.

Прочитайте комментарии и настройте их в соответствии с вашими потребностями.

' This option should go at the top of all modules when you write VBA code. So it warns you when you're not defining your variables
Option Explicit

Public Sub ListDir()
    Dim fileName As String
    Dim myPath As String
    Dim targetFilePath As String

    myPath = "d:\survey\"
    fileName = Dir(myPath, vbNormal)

    ' If something goes wrong, don't let the screen updating option off
    On Error GoTo CleanError

    ' Turn off screen updating so there is no flickering when opening and closing files
    Application.ScreenUpdating = False

    Do While fileName <> ""
        targetFilePath = myPath & fileName
        sumColumns targetFilePath
        fileName = Dir()
    Loop

CleanExit:
    Application.ScreenUpdating = True
    Exit Sub

CleanError:
    MsgBox "Something went wrong..."
    GoTo CleanExit
End Sub

Private Function sumColumns(targetFilePath)
    Dim targetWorkbook As Workbook
    Dim targetSheet As Worksheet
    Dim lastRow As Long

    ' Open and set a reference to workbook
    Set targetWorkbook = Workbooks.Open(targetFilePath)

    ' Set a reference to the first = 1 worksheet in file (beware that this may not always be the first visible sheet)
    Set targetSheet = targetWorkbook.Sheets(1)

    ' Get the row number of the last non empty cell in column A (here you should always be careful for what you're defining as non empty)
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row

    ' Set the label in cell
    targetSheet.Range("A" & lastRow + 1).Value = "score"

    ' Set the formula to sum the values in each column
    targetSheet.Range("B" & lastRow + 1).FormulaR1C1 = "=round(SUM(R[-" & lastRow - 1 & "]C:R[-1]C)" & ",2)"
    targetSheet.Range("C" & lastRow + 1).FormulaR1C1 = "=round(SUM(R[-" & lastRow - 1 & "]C:R[-1]C)" & ",2)"

    ' Close saving changes
    targetWorkbook.Close True
End Function

Пожалуйста, не забудьте пометить ответ, если это поможет.