文章/答案/技术大牛

发布

社区首页 >问答首页 >Excel vba，使SUMIF具有动态范围准则

问Excel vba，使SUMIF具有动态范围准则
EN

Stack Overflow用户

提问于 2018-11-14 10:54:41

回答 1查看 2.6K关注 0票数 1

我用VBA编写了一个代码来执行一些自动化的任务。Sheet1是表单，Sheet2是存储这些数据的数据库。我也希望有一个Button时，按下做一个SUMIF在最后一行。

SUMIF(Column containing search values, value to search for, column conaintining items to add)

我的代码如下

Dim ws1, ws2 As Worksheet


Set ws1 = ThisWorkbook.Sheets("DataBase")
Set ws2 = ThisWorkbook.Sheets("Emails")
Set rngr = ws2.Range("C17")
Set rngs = ws2.Range("C18")
Set rngt = ws2.Range("C19")
Set rngu = ws2.Range("C20")
Set rngy = ws2.Range("C21")
Set rngw = ws2.Range("C24")
Set rngz = ws2.Range("C25")


h = ws2.Range("C1")
i = ws2.Range("C2")
j = ws2.Range("C3")
tot1 = "=RC[-1]-RC[-2]"
tot2 = "=SUM(RC[-5]:RC[-1])"
tot3 = "=SUM(RC[-5]:RC[-1])"
tot4 = "=SUM(RC[-2]:RC[-1])"
tot = "=SUM(RC[-16]+RC[-10]+RC[-4]+RC[-1])"
k = ws2.Range("C5")
l = ws2.Range("C6")
m = ws2.Range("C7")
N = ws2.Range("C8")
f = ws2.Range("C11")
o = ws2.Range("C12")
p = ws2.Range("C13")
G = ws2.Range("C15")
r = Application.WorksheetFunction.VLookup(rngr, ws2.Range("E18:F19").Value, 2, False)
s = Application.WorksheetFunction.VLookup(rngs, ws2.Range("E18:F19").Value, 2, False)
t = Application.WorksheetFunction.VLookup(rngt, ws2.Range("E18:F19").Value, 2, False)
u = Application.WorksheetFunction.VLookup(rngu, ws2.Range("E18:F19").Value, 2, False)
y = Application.WorksheetFunction.VLookup(rngy, ws2.Range("E18:F19").Value, 2, False)
w = Application.WorksheetFunction.VLookup(rngw, ws2.Range("E25:F26").Value, 2, False)
Z = Application.WorksheetFunction.VLookup(rngz, ws2.Range("E25:F26").Value, 2, False)


lastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
last_day = ws1.Range("A" & Rows.Count).End(xlUp).Value
col_search = ws1.Range("A3", Range("A" & Rows.Count).End(xlUp))
col_contain = ws1.Range("G3", Range("G" & Rows.Count).End(xlUp))

ws1.Cells(lastRow, 7).Value = Application.WorksheetFunction.SumIf( col_search, "=" & last_day, col_contain)
ws1.Cells(lastRow, 1).Value = Date
ws1.Cells(lastRow, 2) = h
ws1.Cells(lastRow, 3) = i
ws1.Cells(lastRow, 4) = j
ws1.Cells(lastRow, 5) = k
ws1.Cells(lastRow, 6) = l
ws1.Cells(lastRow, 8) = N
ws1.Cells(lastRow, 9) = tot1
ws1.Cells(lastRow, 9).Font.Bold = True
ws1.Cells(lastRow, 10) = f
ws1.Cells(lastRow, 11) = o
ws1.Cells(lastRow, 12) = p
ws1.Cells(lastRow, 13) = G
ws1.Cells(lastRow, 15) = tot2
ws1.Cells(lastRow, 15).Font.Bold = True
ws1.Cells(lastRow, 16) = r
ws1.Cells(lastRow, 17) = s
ws1.Cells(lastRow, 18) = t
ws1.Cells(lastRow, 19) = u
ws1.Cells(lastRow, 20) = y
ws1.Cells(lastRow, 21) = tot3
ws1.Cells(lastRow, 21).Font.Bold = True
ws1.Cells(lastRow, 22) = w
ws1.Cells(lastRow, 23) = Z
ws1.Cells(lastRow, 24) = tot4
ws1.Cells(lastRow, 24).Font.Bold = True
ws1.Cells(lastRow, 25) = tot
ws1.Cells(lastRow, 25).Font.Bold = True


Dim TargetColumns As Variant
Dim SourceCells As Range
Dim rCell As Range
Dim rAddToCell As Range
Dim x As Long

TargetColumns = Array(20, 23) 'Column numbers to place into.
Set SourceCells = ThisWorkbook.Worksheets("Emails").Range("C22,C26")

'Look at each cell in turn.
For Each rCell In SourceCells

    'Find the last cell in the correct column.
    Set rAddToCell = LastCell(ThisWorkbook.Worksheets("DataBase"), CLng(TargetColumns(x)))

    'If there's already a comment then delete it first
    'Then add value from SourceCell into comment in Target column.
    With rAddToCell
        If HasComment(rAddToCell) Then
            .ClearComments
        End If
        .AddComment
        .Comment.Text Text:=rCell.Value
    End With

    x = x + 1
Next rCell

End Sub

从我的实际情况来看，搜索的价值将是最后一次约会。

last_day = ws1.Range("A" & Rows.Count).End(xlUp).Row

我的SUMIF的实际格式是错误的，因为我没有得到想要的结果。也许我的逻辑是错误的，或者代码本身是错误的。

ws1.Cells(lastRow, 7).Value = Application.WorksheetFunction.SumIfs(col_search, last_day, col_contain)

错误：

Run-time error 1004
Application-defined or object-defined error

欢迎您提出任何建议，谢谢

excel

vba

回答 1

Stack Overflow用户

回答已采纳

发布于 2018-11-14 11:13:19

把它改成

last_day = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Value

否则，您将得到上一次使用的行的行号，而不是其值。

另外，您还混合了具有不同语法顺序的SumIf 和 SumIfs 。

SumIfs (多准则)

根据WorksheetFunction.SumIfs法的语法是

SumIfs(RangeToSum, Criteria_range1, Criteria1, Criteria_range2, Criteria2, …)

因此，我认为您需要切换参数并在条件中添加一个"=" &

SumIfs(col_contain, col_search, "=" & last_day)

col_contain =列对和
col_search =针对标准进行测试的列

SumIf (单一标准)

或者使用WorksheetFunction.SumIf法，其中语法为

SumIf(Criteria_range, Criteria, RangeToSum)

任何你能用的

SumIf( col_search, "=" & last_day, col_contain)

请注意，我建议稍微减少代码，并删除不必要的变量。还可以使用有意义的变量名，如wsDB和wsEmails，它们比无意义的编号变量或a、b、c…等单字母变量更容易阅读和理解。

激活Option Explicit也是一个很好的实践:在VBA编辑器中，转到Tools > Options > https://www.excel-easy.com/vba/examples/option-explicit.html，并正确声明所有变量。

Option Explicit

Sub YourProcedureName()
    Dim wsDB As Worksheet
    Set wsDB = ThisWorkbook.Sheets("DataBase")

    Dim wsEmails As Worksheet
    Set wsEmails = ThisWorkbook.Sheets("Emails")

    'm = wsEmails.Range("C7") 'was not used at all

    With wsDB
        Dim NextFreeRow As Long
        NextFreeRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1

        Dim Last_Day As String
        Last_Day = .Range("A" & .Rows.Count).End(xlUp).Value

        Dim Col_Search As Range
        Col_Search = .Range("A3", .Range("A" & .Rows.Count).End(xlUp))

        Dim Col_Contain As Range
        Col_Contain = .Range("G3", .Range("G" & .Rows.Count).End(xlUp))
    End With

    With wsEmails
        wsDB.Cells(NextFreeRow, 7).Value = Application.WorksheetFunction.SumIf(Col_Search, "=" & Last_Day, Col_Contain)
        wsDB.Cells(NextFreeRow, 1).Value = Date
        wsDB.Cells(NextFreeRow, 2) = .Range("C1")
        wsDB.Cells(NextFreeRow, 3) = .Range("C2")
        wsDB.Cells(NextFreeRow, 4) = .Range("C3")
        wsDB.Cells(NextFreeRow, 5) = .Range("C5")
        wsDB.Cells(NextFreeRow, 6) = .Range("C6")
        wsDB.Cells(NextFreeRow, 8) = .Range("C8")
        wsDB.Cells(NextFreeRow, 9) = "=RC[-1]-RC[-2]"
        wsDB.Cells(NextFreeRow, 9).Font.Bold = True
        wsDB.Cells(NextFreeRow, 10) = .Range("C11")
        wsDB.Cells(NextFreeRow, 11) = .Range("C12")
        wsDB.Cells(NextFreeRow, 12) = .Range("C13")
        wsDB.Cells(NextFreeRow, 13) = .Range("C15")
        wsDB.Cells(NextFreeRow, 15) = "=SUM(RC[-5]:RC[-1])"
        wsDB.Cells(NextFreeRow, 15).Font.Bold = True
        wsDB.Cells(NextFreeRow, 16) = Application.WorksheetFunction.VLookup(.Range("C17"), .Range("E18:F19").Value, 2, False)
        wsDB.Cells(NextFreeRow, 17) = Application.WorksheetFunction.VLookup(.Range("C18"), .Range("E18:F19").Value, 2, False)
        wsDB.Cells(NextFreeRow, 18) = Application.WorksheetFunction.VLookup(.Range("C19"), .Range("E18:F19").Value, 2, False)
        wsDB.Cells(NextFreeRow, 19) = Application.WorksheetFunction.VLookup(.Range("C20"), .Range("E18:F19").Value, 2, False)
        wsDB.Cells(NextFreeRow, 20) = Application.WorksheetFunction.VLookup(.Range("C21"), .Range("E18:F19").Value, 2, False)
        wsDB.Cells(NextFreeRow, 21) = "=SUM(RC[-5]:RC[-1])"
        wsDB.Cells(NextFreeRow, 21).Font.Bold = True
        wsDB.Cells(NextFreeRow, 22) = Application.WorksheetFunction.VLookup(.Range("C24"), .Range("E25:F26").Value, 2, False)
        wsDB.Cells(NextFreeRow, 23) = Application.WorksheetFunction.VLookup(.Range("C25"), .Range("E25:F26").Value, 2, False)
        wsDB.Cells(NextFreeRow, 24) = "=SUM(RC[-2]:RC[-1])"
        wsDB.Cells(NextFreeRow, 24).Font.Bold = True
        wsDB.Cells(NextFreeRow, 25) = "=SUM(RC[-16]+RC[-10]+RC[-4]+RC[-1])"
        wsDB.Cells(NextFreeRow, 25).Font.Bold = True
    End With


    Dim TargetColumns As Variant
    TargetColumns = Array(20, 23) 'Column numbers to place into.

    Dim SourceCells As Range
    Set SourceCells = ThisWorkbook.Worksheets("Emails").Range("C22,C26")

    Dim x As Long

    'Look at each cell in turn.
    Dim rCell As Range
    For Each rCell In SourceCells

        'Find the last cell in the correct column.
        Dim rAddToCell As Range
        Set rAddToCell = LastCell(ThisWorkbook.Worksheets("DataBase"), CLng(TargetColumns(x)))

        'If there's already a comment then delete it first
        'Then add value from SourceCell into comment in Target column.
        With rAddToCell
            If HasComment(rAddToCell) Then
                .ClearComments
            End If
            .AddComment
            .Comment.Text Text:=rCell.Value
        End With

        x = x + 1
    Next rCell

End Sub

票数 0

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/53298534

复制

相似问题

问Excel vba，使SUMIF具有动态范围准则
EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问Excel vba，使SUMIF具有动态范围准则EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问Excel vba，使SUMIF具有动态范围准则
EN