Excel VBA中的math有什么问题？

希望这是我在这个项目上的最后一个问题。 我在雅虎问了这个问题，所以我在这里没有问太多的问题，但没有人回来。

在Excel VBA代码中，我试图在列B中search相同date和高亮颜色之后，在列H中添加值。 我有代码循环search和find匹配的单元格，并执行我想要的math运算。 math运算是获得与search条件一起find的列B的同一行的列H的值。 当我运行macros时，它取得活动行H列的值，结果乘以find的单元格的数量，而不是增加每个值来获得总和。

例如，我正在查找的总数是85，但macros的答案是15，因为活动行中的列H的值是3，并且有5个单元格与search条件相匹配。

我知道这是因为当我不包括起始单元时，答案是12，因为有4个单元。

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

我在我的代码中的math错误是什么？ 我该如何解决？ 我有searchfunction工作。 我只需要获取选定的行值，并添加其他search匹配列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：下面是用户[标签：托马斯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 

这是代码所做的一切。

我想要的不是突出显示红色，而是find这些红色单元格和没有突出显示但是原始search源（单元格H15）的单元格的总和，然后将这些总和分配给一个variables，如' 总价值'

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