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

我试图打开一个新的工作簿，并将列“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

尝试下面的代码：

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

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

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

• 一旦你select工作簿，它将总结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