彩色范围之间的总和

时间:2015-06-15 00:20:49

标签: excel vba excel-vba

我试图在具有相同内部颜色的两个单元格之间求和一系列值。输出应该指向一个单元格。目标是让用户定义输出的起始单元格和单元格,并且函数应该运行,直到它更改列或找到具有相同内部函数的单元格。

这就是我所做的,但每次都会出现#Value错误。请注意,当列移动以停止计算时,我还没有添加规则,而我的总和可能是错误的可能原因,但我不确定。

Function CountCcolor(range_data As Range, criteria As Range, valx As Range) As Long

Dim datax As Range
Dim xcolor As Long


xcolor = criteria.Interior.ColorIndex
valx = 0

For Each datax In range_data

    If datax.Interior.ColorIndex = xcolor Then
        Exit For
    End If

    If datax.Interior.ColorIndex <> xcolor Then
        valx = datax.Value

    End If

Next datax

End Function

3 个答案:

答案 0 :(得分:0)

要获得有色单元格之间的单元格值,您可以使用以下内容:

Function CountCcolor(range_data As Range, criteria As Range)
Dim datax As Range, CountVal, x%
For Each datax In range_data
    If datax.Interior.Color = criteria.Interior.Color Then
       x = x + 1
    End If
    If datax.Interior.Color <> criteria.Interior.Color And x = 1 Then
        CountVal = CountVal + datax.Value
    End If
Next datax
CountCcolor = CountVal
End Function

输出

enter image description here

要获得有色单元格之间的单元格计数,您可以使用它:

Function CountCcolor(range_data As Range, criteria As Range)
Dim datax As Range, CountVal, x%
For Each datax In range_data
    If datax.Interior.Color = criteria.Interior.Color Then
       x = x + 1
    End If
    If datax.Interior.Color <> criteria.Interior.Color And x = 1 Then
        CountVal = CountVal + 1
    End If
Next datax
CountCcolor = CountVal
End Function

输出

enter image description here

答案 1 :(得分:0)

看起来您没有为您的函数指定返回值:

例如

'Not exactly sure what you want to return but this 
'is how you return a value from a function before you exit

'Assign return value to function name
CountCcolor = valx

答案 2 :(得分:0)

我可能误解了你的要求,但这就是我想出来的:

Option Explicit

Public Sub sumColor(dataRng As Range, criteriaRng As Range, sumRng As Range)
    Dim xFound As Variant, xData As Range, xColor As Long, sumData As Long, lr As Long
    Dim fr As Long, fc As Long, foundRng As Range, inProgress As Boolean

    xColor = criteriaRng.Interior.ColorIndex
    sumData = 0
    lr = dataRng.Rows.Count
    For Each xData In dataRng   'For Each cell in 2D range, it traverse row by row
        With xData
            If .Interior.ColorIndex = xColor Then   'found first cell
                fr = .Row         'get its row
                fc = .Column      'and col
                sumData = xData.Value2  'capture its value

                With dataRng            'rest of the column bellow first found
                    Set foundRng = .Range(.Cells(fr + 1, fc), .Cells(lr, fc))
                End With

                For Each xFound In foundRng 'iterate to end of column
                    inProgress = xFound.Interior.ColorIndex = xColor
                    If inProgress Then
                        sumData = sumData + xFound.Value2
                    Else
                        Exit For
                    End If
                Next
                If Not inProgress Then Exit For
            End If
        End With
    Next
    sumRng.Value2 = sumData
    If sumData > 0 Then sumRng.Offset(0, 1).Value2 = "(Col " & xData.Column & ")"
End Sub

结果:

SumColor

此功能在Sheet1模块中:

Option Explicit

Public Sub x()
    With Me
        sumColor .UsedRange, .Range("B8"), .Range("D8")
        sumColor .UsedRange, .Range("B9"), .Range("D9")
        sumColor .UsedRange, .Range("B10"), .Range("D10")
        sumColor .UsedRange, .Range("B11"), .Range("D11")
    End With
End Sub