首页 > 解决方案 > 对特定列的范围求和

问题描述

我想构建一个动态报告,为此,如果标题等于特定文本,则对标题下方的整个列求和。这是我拥有的代码。

Sub FindIfSumColumn()
    Dim LastRow As Long
    Dim rgFound As Range
    Dim mFound As Range
    Dim bd As Worksheet: Set bd = Sheets("BDD")
    Dim dt As Worksheet: Set dt = Sheets("DICT")

    LastCol = bd.Cells(1, Columns.Count).End(xlToLeft).Column

    Set mFound = dt.Range("B2")

    Set rgFound = bd.Range("A1:XFD" & LastCol).Find(What:=mFound, _
    LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)

    If rgFound Is Nothing Then
        MsgBox "Nothing"
    Else
        LastRow = rgFound.Cells(Rows.Count, 1).End(xlUp).Row
        dt.Range("B4") = Application.WorksheetFunction.Sum(LastRow)
    End If
End Sub

标签: excelvba

解决方案


逻辑

  1. 找到标题
  2. 获取标题下方的行
  3. 获取该标题下的最后一行
  4. 创建您的范围以求和
  5. 求和

提示:如果你给你的变量起有意义的名字,它会更容易。这样就更容易理解它们的用途

这是你正在尝试的吗?

Option Explicit

Sub FindIfSumColumn()
    Dim StartRow As Long, LastRow As Long
    Dim FoundColumn As String
    Dim StringToFind As String
    Dim ResultRange As Range
    Dim sumRng As Range

    Dim bd As Worksheet: Set bd = Sheets("BDD")
    Dim dt As Worksheet: Set dt = Sheets("DICT")

    StringToFind = dt.Range("B2").Value

    Set ResultRange = bd.Cells.Find(What:=StringToFind, LookIn:=xlValues, _
                                    LookAt:=xlWhole, SearchOrder:=xlByColumns)

    If ResultRange Is Nothing Then
        MsgBox "Nothing"
    Else
        '~~> Get the row after the header
        StartRow = ResultRange.Row + 1
        '~~> Column of the header
        FoundColumn = Split(Cells(, ResultRange.Column).Address, "$")(1)
        '~~> Last row under that header
        LastRow = bd.Range(FoundColumn & bd.Rows.Count).End(xlUp).Row

        '~~> The range that we need to sum
        Set sumRng = bd.Range(FoundColumn & StartRow & ":" & FoundColumn & LastRow)

        '~~> Output
        dt.Range("B4") = Application.WorksheetFunction.Sum(sumRng)
    End If
End Sub

推荐阅读