Question

我是VBA的新手。

Endstate - 搜索范围并计算用户指定的填充颜色计算合并单元格的唯一单元格值的实例（我知道，合并废弃所有内容）作为一个完整的单元格。

我已经编译了以下代码，但它工作不正常，任何帮助都将不胜感激！

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（默认值）表示不考虑唯一值。例如，＆＃34; ABC＆＃34;和＆＃34; abc＆＃34;将是相同的唯一值，只计算一次。 True表示考虑案例以确定唯一性。例如，＆＃34; ABC＆＃34;和＆＃34; abc＆＃34;将是不同的唯一值，每个都将被计算在内。
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

在Excel VBA中按颜色计算唯一单元格值

1 个答案: