通过colorIndex计算条件格式化单元格 [英] Counting conditional formatting cells by colorIndex
问题描述
当我逐步运行代码时，我注意到在Range（B6，ws.Cells.SpecialCells（xlCellTypeLastCell））之后，ClearFormats程序跳转到Function CountRed（MyRange As Range）和留在循环一段时间。
这是因为有一个函数CountRed（B6）+ CountGreen（C6）+ CountBlue（D6），例如单元格E6？
此外，我希望列E中的列号集中在中央。
如果退出时间为空，则出错：
结果错误在col E：
结果应如下所示：
原始代码也可以发现这里 - 感谢Floris！
Option Explicit
Private Sub worksheet_change（ByVal target As Range）
如果不相交（目标，范围（B4：Q4））没有，然后
'Sub makeTimeGraph（）
Dim startRow As Long
Dim endRow As Long
Dim entryTimeRow As Long
Dim entryTimeFirstCol As Long
Dim Applicaton
Dim ws As Excel.Worksheet
Dim timeRange As Range
Dim c
Dim timeCols As Range
Dim entryTime
Dim exitTime
Dim formatRange As Excel.Range
Dim eps
eps = 0.000001'a very small number - to处理查找中的舍入误差
Dim entryName
Dim Jim
Dim Mark
Dim Lisa
Dim nameCols As Range
'更改这些行以匹配电子表格的布局
'在这种情况下B4的第一个单元格：
entryTimeRow = 4
entryTimeFirstCol = 2
'时间段在列A中，从单元格A6开始：
设置timeRange =范围（A6，[A6] .End （xlDown））
'输入时间的列：
设置ws = ActiveSheet
设置timeCols =范围（B4：Q4）'选择所需的所有列这里，但只有一行
设置nameCols =范围（B3：Q3）列，名称在第三行
'清除以前的格式
范围（ B6，ws.Cells.SpecialCells（xlCellTypeLastCell））。ClearFormats
Application.ScreenUpdating = False
'循环遍历每个列：
对于每个c在timeCols.Cells
Application.StatusBar = entryName
如果IsEmpty（c）然后GoTo nextColumn
entryTime = c.Value
exitTime = c.Offset（1，0）.Value
entryName = c.Offset（-1,0）.Value
startRow = Application.WorksheetFunction.Match（entryTime + eps，timeRange）+ timeRange.Cells（1.1）.Row - 1
endRow = Application.WorksheetFunction.Match（exitTime - eps，timeRange）+ timeRange。单元格（1.1）.Row - 1
设置formatRange =范围（ws.Cells（startRow，c.Column），ws.Cells（endRow，c.Column））
'选择格式范围
formatRange.Select
'选择颜色名称
选择案例entryName
案例Jim
调用格式TheRange1 （formatRange）'红色Colorinex 3
案例标记
调用格式TheRange2（formatRange）'绿色Colorindex 4
案例Lisa
调用格式TheRange3 （formatRange）'Blue Colorindex 5
结束选择
nextColumn：
下一个c
E如果
范围（A1）。激活
Application.ScreenUpdating = True
End Sub
私有子格式TheRange1（ByRef r As Excel。范围）
r.HorizontalAlignment = xlCenter
r.Merge
'应用颜色红色coloroindex 3
与r.Interior
.Pattern = xlSolid
.ColorIndex = 3
'.TintAndShade = 0.8
Selection.UnMerge
结束
结束子
私有子格式TheRange2（ByRef r As Excel.Range）
r.HorizontalAlignment = xlCenter
r.Merge
'应用颜色绿色Colorindex 4
带r.Interior
.Pattern = xlSolid
.ColorIndex = 4
'.TintAndShade = 0.8
Selection.UnMerge
结束
End Sub
私有子格式TheRange3（ByRef r As Excel.Range）
r.HorizontalAlignment = xlCenter
r.Merge
'应用颜色蓝色Colorindex 5
与r.Interior
.Pattern = xlSolid
.ColorIndex = 5
'.TintAndShade = 0.8
Selection.UnMerge
结束
End Sub
函数CountRed（MyRange As Range ）
Dim i As Integer
Application.Volatile
i = 0
对于每个单元格在MyRange中
如果cell.Interior.ColorIndex = 3然后
i = i + 1
结束如果
下一个单元格
CountRed = i
结束函数
函数CountGreen（MyRange As Range）
Dim i As Integer
Application.Volatile
i = 0
对于每个单元格在MyRange
如果cell.Interior.ColorIndex = 4然后
i = iCount + 1
End If
下一个单元格
CountGreen = i
结束函数
函数CountBlu e（MyRange As Range）
Dim i As Integer
Application.Volatile
i = 0
对于每个单元格在MyRange中
如果cell.Interior.ColorIndex = 5 Then
i = i + 1
结束If
下一个单元格
CountBlue = i
结束函数
我不是写宏的粉丝，除非你用尽了Excel的功能。不是通过ColorIndex来攻击问题，而是回到你的数据源。在E6上使用此公式
{= SUM（（$ B $ 4：$ D $ 4 <= A6）*（$ B $ 5：$ D $ 5> A6））}
记住要使用Ctrl + Shift + Enter启用数组函数，而不是只输入。粘贴，它将执行您正在瞄准的行为。
I have some people, whose working time are shown by the conditional formatting in the cells on their own columns - e.g. B7:B36, C7:C36, D7:D36 and so. I try to count the conditional formatting cells to the column E. The end result in the cell is #Value (Arvo), but when you press F9, then the numbers can be displayed.
When I run the code step by step, I noticed that after the line "Range("B6", ws.Cells.SpecialCells(xlCellTypeLastCell)).ClearFormats program jump to function "Function CountRed(MyRange As Range" and stay in the Loop for some time.
Is this because that there is a function "CountRed(B6)+CountGreen(C6)+CountBlue(D6)" for example in the cell E6?
In addition, I would like the column numbers in column E are concentrated in the central.
Error if exit time is empty:
Result with error in col E:
Results should look like this:
The original code can be also found here - Thanks Floris!
Option Explicit
Private Sub worksheet_change(ByVal target As Range)
If Not Intersect(target, Range("B4:Q4")) Is Nothing Then
'Sub makeTimeGraph()
Dim startRow As Long
Dim endRow As Long
Dim entryTimeRow As Long
Dim entryTimeFirstCol As Long
Dim Applicaton
Dim ws As Excel.Worksheet
Dim timeRange As Range
Dim c
Dim timeCols As Range
Dim entryTime
Dim exitTime
Dim formatRange As Excel.Range
Dim eps
eps = 0.000001 ' a very small number - to take care of rounding errors in lookup
Dim entryName
Dim Jim
Dim Mark
Dim Lisa
Dim nameCols As Range
' change these lines to match the layout of the spreadsheet
' first cell of time entries is B4 in this case:
entryTimeRow = 4
entryTimeFirstCol = 2
' time slots are in column A, starting in cell A6:
Set timeRange = Range("A6", [A6].End(xlDown))
' columns in which times were entered:
Set ws = ActiveSheet
Set timeCols = Range("B4:Q4") ' select all the columns you want here, but only one row
Set nameCols = Range("B3:Q3") ' columns where the names are in the third row
' clear previous formatting
Range("B6", ws.Cells.SpecialCells(xlCellTypeLastCell)).ClearFormats
Application.ScreenUpdating = False
' loop over each of the columns:
For Each c In timeCols.Cells
Application.StatusBar = entryName
If IsEmpty(c) Then GoTo nextColumn
entryTime = c.Value
exitTime = c.Offset(1, 0).Value
entryName = c.Offset(-1, 0).Value
startRow = Application.WorksheetFunction.Match(entryTime + eps, timeRange) + timeRange.Cells(1.1).Row - 1
endRow = Application.WorksheetFunction.Match(exitTime - eps, timeRange) + timeRange.Cells(1.1).Row - 1
Set formatRange = Range(ws.Cells(startRow, c.Column), ws.Cells(endRow, c.Column))
'select format range
formatRange.Select
' select name for coloring
Select Case entryName
Case "Jim"
Call formatTheRange1(formatRange) ' Red Colorinex 3
Case "Mark"
Call formatTheRange2(formatRange) ' Green Colorindex 4
Case "Lisa"
Call formatTheRange3(formatRange) ' Blue Colorindex 5
End Select
nextColumn:
Next c
End If
Range("A1").Activate
Application.ScreenUpdating = True
End Sub
Private Sub formatTheRange1(ByRef r As Excel.Range)
r.HorizontalAlignment = xlCenter
r.Merge
' Apply color red coloroindex 3
With r.Interior
.Pattern = xlSolid
.ColorIndex = 3
'.TintAndShade = 0.8
Selection.UnMerge
End With
End Sub
Private Sub formatTheRange2(ByRef r As Excel.Range)
r.HorizontalAlignment = xlCenter
r.Merge
' Apply color Green Colorindex 4
With r.Interior
.Pattern = xlSolid
.ColorIndex = 4
'.TintAndShade = 0.8
Selection.UnMerge
End With
End Sub
Private Sub formatTheRange3(ByRef r As Excel.Range)
r.HorizontalAlignment = xlCenter
r.Merge
' Apply color Blue Colorindex 5
With r.Interior
.Pattern = xlSolid
.ColorIndex = 5
'.TintAndShade = 0.8
Selection.UnMerge
End With
End Sub
Function CountRed(MyRange As Range)
Dim i As Integer
Application.Volatile
i = 0
For Each cell In MyRange
If cell.Interior.ColorIndex = 3 Then
i = i + 1
End If
Next cell
CountRed = i
End Function
Function CountGreen(MyRange As Range)
Dim i As Integer
Application.Volatile
i = 0
For Each cell In MyRange
If cell.Interior.ColorIndex = 4 Then
i = iCount + 1
End If
Next cell
CountGreen = i
End Function
Function CountBlue(MyRange As Range)
Dim i As Integer
Application.Volatile
i = 0
For Each cell In MyRange
If cell.Interior.ColorIndex = 5 Then
i = i + 1
End If
Next cell
CountBlue = i
End Function
I am not a fan of writing macro, unless you exhausted the capabilities of Excel. Instead of attacking the problem through the ColorIndex, go back to the source of your data. Use this formula on E6
{=SUM(($B$4:$D$4<=A6)*($B$5:$D$5>A6))}
Remember to use Ctrl+Shift+Enter to enable the array function, instead of just Enter. Paste down and it will perform the behavior you are aiming for.
这篇关于通过colorIndex计算条件格式化单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
