bugfix> excel > 投稿

フォントの色で合計する必要があるExcelのセル範囲があります。 列Aは単なるベンダーの名前であり、明らかに5月全体です。

理想的には、この範囲の黒、赤、または青のセルの合計を知りたい そこで、マクロを使用する場合と使用しない場合の2つのシナリオを開発しました。

  1. VBAなし

赤と黒のセルに文字列を追加して、それらが「異なる」ことを確認します 例えば。 268を268cに、66.5を66.5uに変更しますが、52.96は変更しません

そして、以下の配列式を使用します。

{=SUM(IF(ISNUMBER(B7:C16),B7:C16,NUMBERVALUE(LEFT(B7:C16,3))))}

これは66.5の.5をスキップしますが、機能し、 LEFT の3を変更するとすぐに関数(セルをテキストから文字列に切り捨てる)から LEN(B6:C17)-1 機能しません。

  1. VBAを使用

モジュールを挿入し、この式を作成します。この式は独自に機能します。

Function GetCellColor(ByVal Target As Range) As Integer
    GetCellColor = Target.Font.ColorIndex
End Function

以下の式を使用します(配列式であるかどうかに関係なくエラーが発生します)。

=SUM(IF(getcellcolor(B7:C16)=3,B7:C16,0))

*各セルを手動で通過して追加するコードを書くことはできますが、各シナリオの問題は何か疑問に思っています...

回答 2 件
  • QHarrが指摘しているように、 Font.ColorIndex は使用できません  マルチセル範囲で。

    以下は、元のワークシート関数で機能するUDFのバージョンです。

    Function GetCellColor(ByVal Target As Range)
        Dim arr(), r As Long, c As Long
        ReDim arr(1 To Target.Rows.Count, 1 To Target.Columns.Count)
        For r = 1 To UBound(arr, 1)
            For c = 1 To UBound(arr, 2)
                arr(r, c) = Target(r, c).Font.ColorIndex
            Next
        Next
        GetCellColor = arr
    End Function
    
    

  • Target.Font.ColorIndex はできません  複数のセルの範囲で。より大きな範囲を使用すると、 null が生成されます 。

    UDFで範囲を渡し、ループサミングすることができます。また、関数の引数として色を渡します。

    単色:

    Public Function GetCellColor(ByRef Target As Range, ByVal targetColour As Long) As Long
        Dim outValue As Long, currentcell As Range
        For Each currentcell In Target.Cells
            If currentcell.Font.ColorIndex = targetColour Then outValue = outValue + currentCell
        Next currentcell
        GetCellColor = outValue
    End Function
    
    

    最大3色:

    これはおそらく改善する必要がありますが、最後の2色はオプションで、最大3色を使用し、個々の色を複数回渡してはならない場合は、次のようなものを試すことができます。

    Public Function GetCellColor(ByRef Target As Range, ByVal targetColour As Long, Optional ByVal targetColour2 As Variant, Optional ByVal targetColour3 As Variant) As Long
        Dim outValue As Long, currentcell As Range
        Select Case True
        Case Not IsMissing(targetColour2) And Not IsMissing(targetColour3)
            If targetColour2 = targetColour3 Or targetColour = targetColour2 Or targetColour = targetColour3 Then GoTo earlyExit
        Case IsMissing(targetColour2) And Not IsMissing(targetColour3)
            If targetColour = targetColour3 Then GoTo earlyExit
        Case Not IsMissing(targetColour2) And IsMissing(targetColour3)
            If targetColour = targetColour2 Then GoTo earlyExit
        End Select
        For Each currentcell In Target.Cells
            If currentcell.Font.ColorIndex = targetColour Then outValue = outValue + currentcell
            If Not IsMissing(targetColour2) Then
                If currentcell.Font.ColorIndex = targetColour2 Then
                    outValue = outValue + currentcell
                End If
            End If
            If Not IsMissing(targetColour3) Then
                If currentcell.Font.ColorIndex = targetColour3 Then
                    outValue = outValue + currentcell
                End If
            End If
        Next currentcell
        GetCellColor = outValue
        Exit Function
    earlyExit:
      GetCellColor = CVErr(xlErrValue)
    End Function
    
    

あなたの答え