VBA将另一个工作簿中的每列相加

你好，

我想在另一个工作簿中总结每一列（请参阅示例），

我做了下面的代码：

Function sumrange(rng As Range) Summ = 1 For Each cell In rng Do While cell <> "" Summ = Summ + cell.Value Loop Next sumrange = Summ End Function sub test() x = sumrange(Workbooks("Clients").Worksheets("Numbers").Range("A:A")) thisworkbook.worksheets("Result").cells(1,1)=x MsgBox x end sub 

但我不知道如何遍历每列（将有更多的2列），它阻止，因为第一个单元格包含一个string：错误，我怎么能定义它应该从第二个单元开始结束？

Answer 1

您可以使用IsNumeric函数来决定是否将单元格的值添加到总和中：

 Function SumRange(rng As Range) Dim dblSum As Double Dim rngCell As Range For Each rngCell In rng If VBA.IsNumeric(rngCell.Value) Then dblSum = dblSum + CDbl(rngCell.Value) End If Next rngCell SumRange = dblSum End Function 

如果您遍历A列中的所有单元格，并且只有less数条目，则这可能会非常慢。 下面的增强还检查单元格是否为空，并退出循环，否则，空单元格可能计算为零：

 Function SumRange(rng As Range) Dim dblSum As Double Dim rngCell As Range For Each rngCell In rng If VBA.IsEmpty(rngCell.Value) Then Exit For ElseIf VBA.IsNumeric(rngCell.Value) Then dblSum = dblSum + CDbl(rngCell.Value) End If Next rngCell SumRange = dblSum End Function 

Answer 2

使用Range对象的SpecialCells方法仅对数字进行求和

如果数字只是“常数”（例如：不是从公式中推导出来的），那么可以使用：

 Function sumrange(rng As Range) As Double sumrange = WorksheetFunction.Sum(rng.SpecialCells(xlCellTypeConstants, xlNumbers)) End Function 

数字应该只来自公式，然后使用：

 Function sumrange(rng As Range) As Double sumrange = WorksheetFunction.Sum(rng.SpecialCells(xlCellTypeFormulas, xlNumbers)) End Function 

最后，数字既可以是常量，也可以来自公式，然后使用：

 Function sumrange(rng As Range) As Double On Error Resume Next sumrange = WorksheetFunction.Sum(rng.SpecialCells(xlCellTypeFormulas, xlNumbers)) sumrange = sumrange + WorksheetFunction.Sum(rng.SpecialCells(xlCellTypeConstants, xlNumbers)) End Function 

Answer 3

从第二个单元格开始，在函数中指定列并像这样调用。

 Function sumrange(rng As Range, c as integer) dim summ as integer dim I as integer dim cell as integer Summ = 1 'Wouldn't you want to start at 0 for your sum? for i = 2 to 50,000 cell = rng.cells(i,c) Summ = Summ + cell Next sumrange = Summ End Function sub test() x = sumrange(Workbooks("Clients").Worksheets("Numbers").Range("A:A"),'column#') thisworkbook.worksheets("Result").cells(1,1)=x MsgBox x end sub 

Answer 4

您可以使用内置的求和function来无范围地求和范围

例：

 Sub test() Dim LastRow As Long 'open the other workbook , clients Set book = Workbooks.Open("clients.xlsx") 'get last raw starting from B2 down to the last filled cell LastRow = book.Worksheets("Numbers").Range("B2").End(xlDown).Row Debug.Print LastRow Set range2 = book.Worksheets("sheet1").Range("B1:B" & LastRow) sum1 = Application.WorksheetFunction.Sum(range2) Debug.Print sum1 'write result to active sheet ThisWorkbook.Worksheets("result").Cells(1, 1) = sum1 End Sub