自动累加值直到第一次遇到列中的空白单元格

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

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

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 

如果你的代码需要进入一个完整的生产系统，那么你需要防守开始思考更多关于你的代码。 Santosh的回答给了更多防守风格的帮助。

Answer 2

试试下面的代码：

• 复制下面的代码粘贴到任何模块。

• 请在运行之前保存文件。

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

• 一旦你选择了工作簿，它会将列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