T
tom taol
There are merged cells in [A1
10].
see the below "c.select" is commented.
by the way, the result is not using "c.select" is not commented.
the answer is not commented.
why????
Sub cnt_blu_red_in_dde()
Call sb_cnt_blue_red(Sheets("DDE").[A1
10])
[F11].Value = blue_cnt
[H11].Value = red_cnt
End Sub
Sub sb_cnt_blue_red(rng As Range)
Dim fcs As FormatConditions
Dim c As Range
Dim adr As String
For Each c In rng
' c.Select
Set fcs = c.FormatConditions
If fcs.Count > 0 Then
If c.MergeCells = True Then
adr = c.Address
For Each c_fir In c.MergeArea
Exit For
Next
If c_fir.Address <> adr Then
GoTo ee:
End If
End If
For i = 1 To fcs.Count
If fcs(i).Type = 1 Then
If fcs(i).Operator = xlEqual Then
If c.Value = Application.Evaluate(fcs(i).Formula1) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlGreater Then
If c.Value > Application.Evaluate(fcs(i).Formula1) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlGreaterEqual Then
If c.Value >= Application.Evaluate(fcs(i).Formula1) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlLess Then
If c.Value < Application.Evaluate(fcs(i).Formula1) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlLessEqual Then
If c.Value <= Application.Evaluate(fcs(i).Formula1) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlBetween Then
If c.Value >= Application.Evaluate(fcs(i).Formula1) And
c.Value <= Application.Evaluate(fcs(i).Formula2) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlNotBetween Then
If c.Value < Application.Evaluate(fcs(i).Formula1) And
c.Value > Application.Evaluate(fcs(i).Formula2) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlNotEqual Then
If c.Value <> Application.Evaluate(fcs(i).Formula1) Then
GoTo zz
End If
End If
ElseIf fcs(i).Type = 2 Then
On Error GoTo xx
If Application.Evaluate(fcs(i).Formula1) = True Then
GoTo zz
End If
End If
Next
End If
ee:
Next
Exit Sub
xx:
Resume ee
zz:
If fcs(i).Interior.ColorIndex = BLUE Then
blue_cnt = blue_cnt + 1
ElseIf fcs(i).Interior.ColorIndex = RED Then
red_cnt = red_cnt + 1
End If
GoTo ee
End Sub
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
see the below "c.select" is commented.
by the way, the result is not using "c.select" is not commented.
the answer is not commented.
why????
Sub cnt_blu_red_in_dde()
Call sb_cnt_blue_red(Sheets("DDE").[A1
[F11].Value = blue_cnt
[H11].Value = red_cnt
End Sub
Sub sb_cnt_blue_red(rng As Range)
Dim fcs As FormatConditions
Dim c As Range
Dim adr As String
For Each c In rng
' c.Select
Set fcs = c.FormatConditions
If fcs.Count > 0 Then
If c.MergeCells = True Then
adr = c.Address
For Each c_fir In c.MergeArea
Exit For
Next
If c_fir.Address <> adr Then
GoTo ee:
End If
End If
For i = 1 To fcs.Count
If fcs(i).Type = 1 Then
If fcs(i).Operator = xlEqual Then
If c.Value = Application.Evaluate(fcs(i).Formula1) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlGreater Then
If c.Value > Application.Evaluate(fcs(i).Formula1) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlGreaterEqual Then
If c.Value >= Application.Evaluate(fcs(i).Formula1) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlLess Then
If c.Value < Application.Evaluate(fcs(i).Formula1) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlLessEqual Then
If c.Value <= Application.Evaluate(fcs(i).Formula1) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlBetween Then
If c.Value >= Application.Evaluate(fcs(i).Formula1) And
c.Value <= Application.Evaluate(fcs(i).Formula2) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlNotBetween Then
If c.Value < Application.Evaluate(fcs(i).Formula1) And
c.Value > Application.Evaluate(fcs(i).Formula2) Then
GoTo zz
End If
ElseIf fcs(i).Operator = xlNotEqual Then
If c.Value <> Application.Evaluate(fcs(i).Formula1) Then
GoTo zz
End If
End If
ElseIf fcs(i).Type = 2 Then
On Error GoTo xx
If Application.Evaluate(fcs(i).Formula1) = True Then
GoTo zz
End If
End If
Next
End If
ee:
Next
Exit Sub
xx:
Resume ee
zz:
If fcs(i).Interior.ColorIndex = BLUE Then
blue_cnt = blue_cnt + 1
ElseIf fcs(i).Interior.ColorIndex = RED Then
red_cnt = red_cnt + 1
End If
GoTo ee
End Sub
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!