Excelでの固有のセル値の計算VBA

Question

VBAを初めて使用しました。

Endstateは - の範囲を検索し、ユーザー指定の満たされた色は1つのセル全体として（遺跡すべてをマージし、私が知っている）マージされたセルをカウントするためのユニークなセル値のインスタンスをカウントします。

が、私は以下のコードをコンパイルしたが、それは非常に適切で働いていない、任意の助けをいただければ幸いです！

Function CountUniqueColorBlocks(SearchRange As Range, ColorRange As Range) As Long 
Dim cell As Range, blocks As Range 
Dim dict As Scripting.Dictionary 
Set dict = New Scripting.Dictionary 
Set blocks = SearchRange(1).MergeArea(1) ' prime union method (which requires >1 value) 
For Each cell In SearchRange 
    If cell.Interior.Color = ColorRange.Interior.Color And Not dict.Exists(cell.Value) Then 
     dict.Add cell.Value, 0 
End If 
Next 
CountUniqueColorBlocks = dict.Count 
End Function 

Answer 1

そして、私はそれが楽しいと思ったので、ここで私はそれが（する必要はありません）、デフォルトで空白を無視して、とのすべてのセルをカウントします、それは一度だけマージされたセルをカウント確保します作成したUDFです選択された色ですが、オプションとしてこれらのセルの一意の値のみをカウントできます。あなたが意図したとおり、それは唯一選ばれた色のためのユニークな値をカウントするようにそれを使用するには、式は次のようになります。=CountColor(A1:C4,A3,TRUE)

引数：

• CheckRange：必須。必須：これは
• ColorCompareCellを数える色のためにループスルーされるセルの範囲です。これは、集計したい色を含む単一のセル（マージすることはできません）です。
• UnqOnly：オプション。 False（デフォルト）はすべての値がカウントされることを意味し、Trueはユニークな値のみがカウントされることを意味します。
• CaseSensitive：オプション。 UnqOnlyがTrueに設定されている場合のみ関連します。 False（デフォルト）は、一意の値が大文字と小文字を区別しないことを意味します。たとえば、「ABC」と「abc」は同じ固有値で、1回のみカウントされます。真とは、一意性を決定するためにケースが考慮されることを意味します。たとえば、「ABC」と「abc」は異なる固有の値になり、それぞれがカウントされます。
• IgnoreBlanks：オプション。 True（デフォルト）は、空白の値を持つセルが、選択した色を含んでいてもカウントされないことを意味します。 Falseは、空白の値を持つセルがとにかくカウントされることを意味します。

全UDFコード：

Public Function CountColor(ByVal CheckRange As Range, _ 
          ByVal ColorCompareCell As Range, _ 
          Optional ByVal UnqOnly As Boolean = False, _ 
          Optional ByVal CaseSensitive As Boolean = False, _ 
          Optional ByVal IgnoreBlanks As Boolean = True) As Variant 

    Dim UnqValues As Object 
    Dim NewCell As Boolean 
    Dim CheckCell As Range 
    Dim MergedCells As Range 
    Dim TotalCount As Long 

    If ColorCompareCell.Cells.Count <> 1 Then 
     CountColor = CVErr(xlErrRef) 
     Exit Function 
    End If 

    If UnqOnly Then Set UnqValues = CreateObject("Scripting.Dictionary") 

    For Each CheckCell In CheckRange.Cells 
     NewCell = False 
     If CheckCell.MergeArea.Address <> CheckCell.Address Then 
      If MergedCells Is Nothing Then 
       Set MergedCells = CheckCell.MergeArea 
       NewCell = True 
      Else 
       If Intersect(CheckCell, MergedCells) Is Nothing Then 
        Set MergedCells = Union(MergedCells, CheckCell.MergeArea) 
        NewCell = True 
       End If 
      End If 
     Else 
      NewCell = True 
     End If 

     If NewCell Then 
      If CheckCell.Interior.Color = ColorCompareCell.Interior.Color Then 
       If UnqOnly Then 
        If CaseSensitive Then 
         If IgnoreBlanks Then 
          If Len(Trim(CheckCell.Value)) > 0 Then UnqValues(WorksheetFunction.Trim(CheckCell.Value)) = WorksheetFunction.Trim(CheckCell.Value) 
         Else 
          UnqValues(WorksheetFunction.Trim(CheckCell.Value)) = WorksheetFunction.Trim(CheckCell.Value) 
         End If 
        Else 
         If IgnoreBlanks Then 
          If Len(Trim(CheckCell.Value)) > 0 Then UnqValues(LCase(WorksheetFunction.Trim(CheckCell.Value))) = LCase(WorksheetFunction.Trim(CheckCell.Value)) 
         Else 
          UnqValues(LCase(WorksheetFunction.Trim(CheckCell.Value))) = LCase(WorksheetFunction.Trim(CheckCell.Value)) 
         End If 
        End If 
       Else 
        If IgnoreBlanks Then 
         If Len(Trim(CheckCell.Value)) > 0 Then TotalCount = TotalCount + 1 
        Else 
         TotalCount = TotalCount + 1 
        End If 
       End If 
      End If 
     End If 
    Next CheckCell 

    If UnqOnly Then CountColor = UnqValues.Count Else CountColor = TotalCount 

End Function