How to calculate the sum for all files in a directory when to iterate them?

问题

All files in directory survey contain same structure.
Data in x1.xls:

Data in x2.xls:

I want to get sum of b column and c column for both x1.xls and x2.xsl.
Result for x1.xls.

Same sum for x2.xls.
I can do with following steps:
1.Open vb editor in x1.xls
2.Edit the below sub and bind ctrl+z with the 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

Different files contain different rows,so use Cells(Rows.Count, "A").End(xlUp).Row to get dynamic rows for different files.

3.Press ctrl+z in x1.xls.
4.Open x2.xls and press ctrl+z.

Now i want to automate the process with vba.

Here is my try:

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

When i execute the sub ListDir() x1.xsl in vba editor ,an error occur:

and maybe there are some other bugs in sumColumns function,how to fix to get what i expect result sum for all files in directory survey?

回答1:

This code should be in a different file than the ones you're trying to modify.

You may run it using F8 key so you say what changes between your code and mine.

Read the comments and adjust it to fit your needs.

' 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

Please remember to mark the answer if it helps.

来源：https://stackoverflow.com/questions/59626886/how-to-calculate-the-sum-for-all-files-in-a-directory-when-to-iterate-them

标签

excel

vba

loops