Excel VBA修改答案

【问题标题】：Excel VBA modificationExcel VBA修改
【发布时间】：2014-05-19 15:58:03
【问题描述】：

如果单元格具有特定的背景填充颜色（由参考单元格给出），我有以下 VBA 代码用于对单元格进行计数或求和：

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)

Dim rCell As Range
Dim lCol As Long
Dim vResult

lCol = rColor.Interior.ColorIndex

    If Count = True Then
       For Each rCell In rRange
          If rCell.Interior.ColorIndex = lCol Then
              vResult = WorksheetFunction.Count(rCell) + vResult
          End If
       Next rCell
    Else
       For Each rCell In rRange
          If rCell.Interior.ColorIndex = lCol Then
              vResult = 1 + vResult
          End If
       Next rCell
    End If

ColorFunction = vResult

End Function

由于我不熟悉 VBA 环境，如何修改此代码以接受 2 个单元格作为背景填充颜色的“基线”，并在一行单元格包含两个输入时输出范围的计数/总和颜色？

【问题讨论】：

Count 设置在哪里？您是要查看背景颜色和前景色，还是您的意思是任何一个单元格都是特定颜色？如果您想查看加色，那么我们是简单地将这些值相加（RGB），还是您只对原色进行操作？
@SeanCheshire 我的意思是我想修改函数以接受两种“输入”颜色和一个总和/计数范围。也就是说，例如，如果我有两个输入单元格 A1 和 B1，并且我的总和/计数范围为单元格 C1:D20，如果只有单元格 C10 和 D10 具有 A1 和 B1 中指定的颜色，则计数将返回 1 （即它逐行检查）。我不想将颜色加在一起，只是计算单元格或根据背景填充颜色对内容求和。
我假设Count 应该是SUM。如果您是unfamiliar with the VBA environment，那么如果发布了答案，您就不太可能理解答案。在网上搜索“Excel VBA 教程”以访问一个好的库并查看他们的 Excel VBA Primers。您花在学习 VBA 上的时间会很快得到回报。
@TonyDallimore 我很欣赏这种情绪，但我可以用 C++ 和 Python 编写代码，而不是 VB。我有能力理解它，但我不确定语法等。另外，这段代码是直接从另一个论坛复制的......
除了展示如何访问内部颜色索引之外，我认为发布的代码对于创建您寻求的功能几乎没有价值。当前函数按单元格循环遍历一个范围。您想将 rRange 拆分为行，然后将其拆分为每行中的单元格。 VBA 的语法是一个小问题。理解 Excel 对象模型对您来说是个大问题。

标签： excel colors vba

【解决方案1】：

了解 VBA 的第一件事是，除非您指定，否则它不需要变量声明 - 任何引用的新变量都会自动创建为未初始化的变体。这对于快速编程很有用，但对于玩具编程以外的任何东西都无用。

总是把Option Explicit作为你的模块的第一行，当你使用initialied=0而不是initialized=0而不是创建一个新变量时它会抛出一个错误，并且很难调试。 ..

我也会在定义变量时使用 CamelCase，并继续输入小写字母 - vba 将根据需要大写，因此如果您输入错误的变量，当您完成该行时它不会变为大写字母

Dim TestIt
testit = 1 'will change to TestIt = 1
testti = 1 'will not have upper case letters

说了这么多，让我们看一下程序。

我们需要做的第一件事是检查您实际上是否为颜色提供了 2 个单元格。这可以通过检查细胞计数来完成：

If rColor.Cells.Count <> 2 Then
    ...

接下来是检查我们至少有 2 列要检查

If rRange.Columns.Count = 1 Then
    ....

最后我们必须改变总计/总和的逻辑。目前，它单独检查每个单元格，并且无法查看是否在同一行上找到了另一种颜色，因此我们必须更改它以单独检查每一行。这很容易通过 2 个嵌套的 For ... Next 循环来完成

检查完一行后，我们需要检查两种颜色是否都已找到。我们可以定义几个标志来测试它。

If rRange.Cells(LoopCols, LoopRows).Interior.ColorIndex = Color1 Then
    Find1stColor = True

第二个颜色也一样，在行尾用

检查

If Find1stColor And Find2ndColor Then

一旦我们定义了这个结构，我们就可以编写我们的程序了：

Option Explicit

Function Color2Function(rColor As Range, rRange As Range, Optional SUM As Boolean)

Dim RowCount As Long
Dim ColCount As Long
Dim tempResult
Dim Color1 As Long
Dim Color2 As Long
Dim Totals
Dim LoopRows As Long
Dim LoopCols As Long
Dim Find1stColor As Boolean
Dim Find2ndColor As Boolean

If rColor.Cells.Count <> 2 Then
    Color2Function = CVErr(xlErrRef) 'Error 2023 returns #REF!
    Exit Function
End If

Color1 = rColor.Cells(1).Interior.ColorIndex
Color2 = rColor.Cells(2).Interior.ColorIndex

RowCount = rRange.Rows.Count
ColCount = rRange.Columns.Count

If ColCount = 1 Then
    Color2Function = 0 ' one column can never contain 2 colors
    Exit Function
End If

For LoopRows = 1 To RowCount
    Find1stColor = False
    Find2ndColor = False
    tempResult = 0
    For LoopCols = 1 To ColCount
        If rRange.Cells(LoopCols, LoopRows).Interior.ColorIndex = Color1 Then
            Find1stColor = True
            tempResult = tempResult + rRange.Cells(LoopCols, LoopRows).Value
        End If
        If rRange.Cells(LoopCols, LoopRows).Interior.ColorIndex = Color1 Then
            Find2ndColor = True
            tempResult = tempResult + rRange.Cells(LoopCols, LoopRows).Value
        End If
    Next
    If Find1stColor And Find2ndColor Then
        If SUM Then
            Totals = Totals + tempResult
        Else
            Totals = Totals + 1
        End If
    End If
Next

Color2Function = Totals

End Function

我把它作为一个练习，让你自己决定如果不止一次发现其中一种颜色该怎么办。

【讨论】：