vba - 自动对值求和，直到第一次遇到列中的空白单元格

Question

我正在尝试打开一个新工作簿并将“A”列中的值相加并粘贴到第一个空白单元格中。但是总和没有显示在空白单元格中。

Path = ActiveWorkbook.Path
Filename = InputBox("Enter an input file name")
MsgBox Filename
InputFile = Path & "\"

InputFile = InputFile & Filename
MsgBox InputFile
Workbooks.Open Filename:=InputFile

'Activating the Raw Data Report
Set InputFile = ActiveWorkbook
Set InputFileSheet = InputFile.Sheets("Sheet1")
InputFileSheet.Select
InputFileSheet.Activate

Set r = Range(Range("A1"), Cells(Rows.Count, "A"))
Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = Application.WorksheetFunction.Sum(r)

Answer 1

试试下面的代码：

• 复制以下代码并粘贴到任何模块。

• 请在运行前保存文件。

• 该代码将要求选择您要打开的工作簿。

• 选择工作簿后，它将汇总 A 列的值并放入最后一个单元格。

Sub test()
    Dim Path As String
    Dim fileName As String
    Dim wkb As Workbook

    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.AllowMultiSelect = False


    Dim FileChosen As Integer

    FileChosen = fd.Show

    fd.Title = "Summary Data"
    fd.InitialView = msoFileDialogViewSmallIcons


    fd.Filters.Clear
    fd.Filters.Add "Excel macros", "*.xls*"


    fd.FilterIndex = 1


    If FileChosen <> -1 Then
        MsgBox "You chose cancel"
        Path = vbNullString
    Else
        Path = fd.SelectedItems(1)
    End If

    If Path <> vbNullString Then
        fileName = GetFileName(Path)

        If IsWorkBookOpen(Path) Then
            Set wkb = Workbooks(fileName)
        Else
            Set wkb = Workbooks.Open(fileName)
        End If

        If Not wkb Is Nothing Then
            With wkb.Sheets("sheet1")
                Set r = .Range(.Cells(1, 1), .Cells(.Rows.Count, "A"))
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = Application.WorksheetFunction.Sum(r)
            End With
        End If
    End If
End Sub

Function GetFileName(fullName As String, Optional pathSeparator As String = "\") As String

    Dim i As Integer
    Dim iFNLenght As Integer
    iFNLenght = Len(fullName)

    For i = iFNLenght To 1 Step -1
        If Mid(fullName, i, 1) = pathSeparator Then Exit For
    Next

    GetFileName = Right(fullName, iFNLenght - i)

End Function

Function IsWorkBookOpen(fileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open fileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0: IsWorkBookOpen = False
    Case 70: IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

Answer 2

一些小的变化，我认为你的例程可以缩短：

Dim Path As String, Filename As String, InputFile As String
Path = Excel.ActiveWorkbook.Path
Filename = InputBox("Enter an input file name")
InputFile = Path & "\" & Filename

MsgBox InputFile

Excel.Workbooks.Open Filename:=InputFile

 'Activating the Raw Data Report
Dim rawData As Excel.Workbook
Set rawData = Excel.Workbooks(Filename)

Dim r As Excel.Range
With rawData.Sheets("Sheet1")
   Set r = .Range(.Range("A1"), .Cells(.Rows.Count, "A"))
   .Range("A" & .Cells(.Rows.Count, 1).End(Excel.xlUp).Row + 1) = Excel.Application.WorksheetFunction.Sum(r)
End With

如果您的代码需要进入完整的生产系统，那么您需要开始更加防御性地考虑您的代码。桑托什的回答为如何实现更具防御性的风格提供了很多帮助。