VBA对另一个工作簿中的每一列求和

Question

你好，

我想对另一个工作簿中的每一列求和（参见示例），

我做了以下代码：

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列）并且它会阻塞，因为第一个单元格包含一个字符串：error，我该如何定义它应该从第二个单元格开始到结束？

Answer 1

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

数字应该是“常数”（例如：不是从公式推导出来），然后使用：

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 2

您可以使用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中的所有单元格并且只有少数几个条目，那么这可能会非常慢。以下增强功能还会检查单元格IsEmpty是否会退出循环（如果是这种情况） - 否则，空单元格可能会评估为零：

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 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

您可以使用内置和函数

对范围求和而不进行循环

示例：

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