Question

我有一个函数的以下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个单元作为＆＃34; baselines＆＃34;对于背景填充颜色，如果一行单元格包含两种输入颜色，则输出范围的计数/总和？

Answer 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

如果其中一种颜色被发现不止一次，我会把它作为练习让自己决定做什么。

Excel VBA修改

1 个答案: