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

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