Excel VBA : CountIf (값 기준) AND (색상 기준)

Question

참조 셀과 같은 색을 가진 범위의 셀 수를 계산하려고합니다. 다른 범위의 해당 셀에 올바른 값 기준이있는 경우 . 예를 들어

경우 (A1 < 350) 및 (B1이 기준 셀과 동일한 색상을 갖는), 다음 행 위에 1 루프 카운트 1~15

에 질문과 같은 문제가 본질적 여기에 게시 :
http://www.mrexcel.com/forum/excel-questions/58582-countif-multiple-criteria-one-being-interior-color.html

불행히도, ExtCell.zip 파일이 더 이상 종료되지 않는 것 같습니다. 따라서 주어진 솔루션을 단순히 복제 할 수는 없습니다. 나는 SUMPRODUCT 함수를 사용하여 동일한 접근법을 따르려고했지만 셀 색상을 비교하는 함수를 작성했지만 작동하지 않았습니다. "수식에 사용 된 값이 잘못된 데이터 유형입니다."라는 오류가 나타납니다. 내 코드는 다음과 같습니다. Windows 7에서 Excel 2007을 사용하고 있습니다. 도움을 주시면 감사하겠습니다. 감사!

=SUMPRODUCT((B57:B65<350) * (ColorCompare(D307,D57:D65))) 

위의 수식은 셀에 입력됩니다. B57:B65에는 숫자 값이 포함되어 있으며, D57:D65은 색이 지정된 셀입니다. D307은 올바른 색상의 참조 셀입니다.

'' VBA function ColorCompare 
Function ColorCompare(refCell As Range, compareCells As Range) As Variant 
    Dim rCell As Range 
    Dim TFresponses() As Boolean  'the boolean array to be returned to SUMPRODUCT 

    Dim CallerCols As Long  'find out the number of cells input by the user 
           'so as to define the correct array size 
    With Application.Caller 
     CallerCols = .Column.Count 
    End With 
    ReDim TFresponses(1 To CallerCols) 

    Dim Idx As Long 
    Idx = 1 
    For Each rCell In compareCells 
     If rCell.Interior.ColorIndex = refCell.Interior.ColorIndex Then 
      TFresponses(Idx) = 1 
      Idx = Idx + 1 
     Else 
      TFresponses(Idx) = 0 
      Idx = Idx + 1 
     End If 
    Next rCell 

    ColorCompare = TFresponses 

End Function 

Answer 1

문제의 몇

1. 당신은 compareCells의 크기를 결정해야하는 코드에있다 , 호출자 셀이 아닙니다.
2. 열을 고려하고 있습니다. 행 (또는 행 최대 flexability에 대한 열)는
3. 몇 최적화가 여기에 귀하의 기능

   Function ColorCompare(refCell As Range, compareCells As Range) As Variant 
       Dim rCell As Range, rRw As Range 
       Dim TFresponses() As Boolean  'the boolean array to be returned to SUMPRODUCT 
       Dim rw As Long, cl As Long 
       Dim clr As Variant 
   
       clr = refCell.Interior.ColorIndex 
       ReDim TFresponses(1 To compareCells.Rows.Count, 1 To compareCells.Columns.Count) 
   
       rw = 1 
       For Each rRw In compareCells.Rows 
        cl = 1 
        For Each rCell In rRw.Cells 
         If rCell.Interior.ColorIndex = clr Then 
          TFresponses(rw, cl) = True 
         End If 
         cl = cl + 1 
        Next rCell 
        rw = rw + 1 
       Next rRw 
       ColorCompare = TFresponses 
   End Function 
   

   주의 리팩토링 버전의 당신이

을 할 수 있다는 것을이 어떤 모양의 범위에 대한 결과를 반환하면서, 유용하게 사용하려면 SumProduct 범위 1 행 최고 또는 1 열 (샘플 수식처럼)을 전달하십시오.

Answer 2

보십시오이 (주어진 공식 업데이트 : =SUMPRODUCT((B57:B65<350) * (ColorCompare(D307,D57:D65)))) :

Sub test() 
i = 57 
While Not IsEmpty(Cells(i, 1)) 
If Cells(i, 2) < 350 And Cells(i, 4).Interior.ColorIndex = Cells(307, 4).Interior.ColorIndex Then 'replace with your reference cell 
count = count + 1 
End If 
i = i + 1 
Wend 
End Sub