Question

希望这是我关于这个项目的最后一个问题。我在雅虎问过这个问题所以我不会在这里问太多问题，但没有人回过头来。

在Excel VBA代码中，我尝试在B列中搜索相同日期并突出显示颜色后，在列H中添加值。我有代码循环搜索并找到匹配的单元格并执行我想要的数学运算。数学运算是获取与搜索条件一起找到的B列的同一行的列H的值。当我运行宏时，它采用活动行的列H的值，并将结果乘以找到的单元格数，而不是添加每个值以获得总和。

例如，我要查找的总和是85，但宏的答案是15，因为活动行中的列H的值是3，并且有5个单元符合搜索条件。

我知道这一点，因为当我没有输入起始细胞时，答案是12，因为有4个细胞。

我正在寻找的例子：我选择日期为“7/22/2016”的最后一个绿色突出显示的单元格（单元格B15）我想获得同一行的列H的值（这将是H15）并且仅添加具有绿色突出显示日期“7/22/2016”（单元格; H15 + H7 + H3 + H2 + H1）的列H值，其应该等于85

我的代码中的数学运算出错了什么？我该如何解决？我有搜索功能工作。我只需要获取所选的行值并添加与列H值匹配的其他搜索。

在用户[标签：Thomas Inzina]的帮助下，我能够提出这段代码：

Sub FindMatchingValue()
    Const AllUsedCellsColumnB = False
    Dim rFound As Range, SearchRange As Range
    Dim cellValue As Variant, totalValue As Variant

    ' Get the H value of active row and set it to totalValue
    cellValue = Range("H" & ActiveCell.Row)
    totalValue = cellValue

    ' set search range
    If AllUsedCellsColumnB Then
        Set SearchRange = Range("B1", Range("B" & Rows.Count).End(xlUp))
    Else
        Set SearchRange = Range("B1:B30")
    End If

    ' If there is no search range, show Msg
    If Intersect(SearchRange, ActiveCell) Is Nothing Then
        SearchRange.Select
        MsgBox "You must select a cell in the highlighted area before continuing", vbInformation, "Action Cancelled"
        Exit Sub
    End If

    ' Get search criteria & set it to rFound
    Set rFound = SearchRange.Find(What:=ActiveCell.Value, _
                                  After:=ActiveCell, _
                                  LookIn:=xlValues, _
                                  LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, _
                                  SearchFormat:=False)


    ' If rFound is not Nothing, then do math. If rFound is Nothing, then findnext
    If Not rFound Is Nothing Then

        Do

            If rFound.Style.Name = "Good" Then

                totalValue = totalValue + cellValue

            End If

            Set rFound = SearchRange.FindNext(rFound)

        ' Loop till all matching cells are found
        Loop While Not rFound Is Nothing And rFound.Address <> ActiveCell.Address
    End If

    Range("D1") = totalValue ' Show value in test cell to see if math works

End Sub

这是电子表格的图片

编辑1：下面是用户[标签：Thomas Inzina]帮助我提出的代码。

Sub FindMatchingValue()
    Const AllUsedCellsColumnB = False
    Dim rFound As Range, SearchRange As Range
    ' DOES NOT HAVE "cellValue" or "totaValue"

    If AllUsedCellsColumnB Then
        Set SearchRange = Range("B1", Range("B" & Rows.Count).End(xlUp))
    Else
        Set SearchRange = Range("B1:B30")
    End If

    If Intersect(SearchRange, ActiveCell) Is Nothing Then
        SearchRange.Select
        MsgBox "You must select a cell in the highlighted area before continuing", vbInformation, "Action Cancelled"
        Exit Sub
    End If

    Set rFound = SearchRange.Find(What:=ActiveCell.Value, _
                                  After:=ActiveCell, _
                                  LookIn:=xlValues, _
                                  LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, _
                                  SearchFormat:=False)



    If Not rFound Is Nothing Then

        Do

            If rFound.Style.Name = "Good" Then

                Range("H" & rFound.Row).Interior.Color = vbRed 'THIS IS THE MAIN CHANGE

            End If

            Set rFound = SearchRange.FindNext(rFound)

        Loop While Not rFound Is Nothing And rFound.Address <> ActiveCell.Address
    End If

End Sub

这是代码所做的图片。

我想要的不是突出显示红色，而是找到这些红色单元格的总和以及未突出显示但是原始搜索源（单元格H15）的单元格，然后取这些红色单元格的总和并将其分配给变量，例如'totalValue'

Answer 1

使用以下作为数学部分。它将添加查找发生的行的值（而不是初始值），如果它是唯一匹配，它还将避免计算初始值两次。

' If rFound is not Nothing, then do math. If rFound is Nothing, then findnext
If Not rFound Is Nothing Then
    If rFound.Address <> ActiveCell.Address Then
        Do

            If rFound.Style.Name = "Good" Then

                totalValue = totalValue + rFound.Offset(0, 6).Value

            End If

            Set rFound = SearchRange.FindNext(rFound)

        ' Loop till all matching cells are found
        Loop While Not rFound Is Nothing And rFound.Address <> ActiveCell.Address
    End If
End If

我在Excel VBA中的数学有什么问题？

1 个答案: