1

样本Excel

要求是一段代码，它可以计算字符串的实例，即（ABC，DEF，GHK），基于它们是否存在于彩色单元格中，并将结果放在下面的单元格中，如图所示。

有人可以请教吗？

我尝试了一个示例代码

Sub Color()

Dim varCounter As String
Dim color As Integer
Dim nocolor As Integer

Range("E5").Select
color= 0
nocolor= 0

      Do Until Selection.Value = ""
                  If Selection.Font.Color = RGB(255, 0, 0) Then
                   color= color+ 1
                     Else
                   nocolor= nocolor+ 1
                   End If
                   Selection.Offset(1, 0).Select
        Loop
  Range("E47").Select
  Selection.Value = no


  Range("E48").Select
Selection.Value = color

End Sub

这是一个非常简单的代码，它检查文本字体是否有颜色，但我找不到任何检查单元格背景颜色的东西。

我也尝试了 excel formula ，但是我只能搜索 text 和 count ，它不计算基于单元格的背景颜色。

4

3 回答 3

3

这是一个简单的用户定义函数。您可以将其放在常规模块中。然后，您可以从它所在的工作簿中的任何工作表中调用它：

Public Function CountByColorAndText(rng As Excel.Range, SearchText As String, CountColored As Boolean) As Long
Dim cell As Excel.Range
Dim CellCount As Long

For Each cell In rng
    If cell.Value = SearchText Then
         If (cell.Interior.ColorIndex = -4142 And Not CountColored) Or _
           (cell.Interior.ColorIndex <> -4142 And CountColored) Then
            CellCount = CellCount + 1
        End If
    End If
Next cell
CountByColorAndText = CellCount
End Function

它需要三个参数：要评估的范围、要搜索的字符串以及您是否计算有色（或无色）单元格：

在此处输入图像描述

因此，在上面的 E 列中，公式为：

=CountByColorAndText($A$2:$A$13,$D3,FALSE)

在 F 列中，除了最后一个参数 is 之外，它是相同CountColored的TRUE。

我不写很多用户定义的函数，所以有人可能会过来指出问题或改进。

于 2013-01-09T05:20:24.200 回答
2

而不是Font.Color使用Interior.Color

于 2013-01-09T03:03:13.540 回答
0

再次编写代码会很棒。但是，如果您有兴趣看一下，我在这里有一个修订后的代码。我只是想知道这是否是一些常见的项目，因为昨天 OP 提出了同样的问题....

VBA，COUNTIF，根据单元格颜色排除

顺便说一句INTERIOR.COLOR，你会看到一个代表 RGB 的大数字，你可能想在哪里使用INTERIOR.COLORINDEX

由于您正在检查RGB格式，您可以尝试以下操作。但是我建议你不要使用select，它会减慢你的代码。您可以根据自己的需要进行sheets更改。ranges

例如

Dim rng as Range
Dim cell as Range

'-- name column
Set rng = Sheets(2).Cells(Sheets(2).Rows.Count, "C").End(xlUp).Row

color= 0
nocolor= 0

 For Each Cell In rng
    If  Cell.InteriorColor = RGB(256,0,0) then
      color= color+ 1
    Else
      nocolor= nocolor+ 1
    End If
  Next Cell

'--output
Sheets(2).Range("E47").Value = nocolor
Sheets(2).Range("E48").Value = color
于 2013-01-09T07:50:28.667 回答