VBA - добавить значение ячейки к общей сумме, если установлен флажок

Question

Я не уверен, что заголовок точно описывает мой запрос, поэтому я постараюсь описать его здесь.

У меня есть лист, который отслеживает расходы и доход, и яу меня есть макрос, который я использую, чтобы вставить флажки в выбранные ячейки, связать флажок с этими ячейками и, наконец, применить условие для условного формата, если флажок установлен, и аналогично, если он снова не установлен.

Здесьэто код, который делает это:

Sub:

Sub Insert_Checkbox_Link_Cell()

    Dim rngCel, myCells As Range
    Dim ChkBx As CheckBox
    Dim cBx As Long

    Set myCells = Selection

    myCells.NumberFormat = ";;;"

    Application.ScreenUpdating = False

    For Each rngCel In myCells

        With rngCel.MergeArea.Cells

            If .Resize(1, 1).Address = rngCel.Address Then

                Set ChkBx = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)

                With ChkBx

                    .Value = xlOff
                    .LinkedCell = rngCel.MergeArea.Cells.Address
                    .Text = ""
                    .Width = 18
                    .Top = rngCel.Top + rngCel.Height / 2 - ChkBx.Height / 2
                    .Left = rngCel.Left + rngCel.Width / 2 - ChkBx.Width / 2
                    .Select

                    'Function Call
                    Selection.OnAction = "Change_Cell_Colour"

                End With

            End If

        End With

    Next rngCel

    If (Range(ChkBx.LinkedCell) = "True") Then

        myCells.Interior.ColorIndex = 43

    Else

        myCells.Interior.ColorIndex = 48

    End If

    Application.ScreenUpdating = True

End Sub

Функция:

Function Change_Cell_Colour()

    Dim xChk As CheckBox
    Dim clickedCheckbox As String

    clickedCheckbox = Application.Caller

    Set xChk = ActiveSheet.CheckBoxes(clickedCheckbox)

    If xChk.Value = 1 Then

        ActiveSheet.Range(xChk.LinkedCell).Interior.ColorIndex = 43

    Else

        ActiveSheet.Range(xChk.LinkedCell).Interior.ColorIndex = 48

    End If

End Function

Так как это работаетя выбираю диапазон ячеек, в которых я хочу установить флажки, затем запускаю макрос, и он вставляет флажки, как указано выше.

Теперь я хочу добавить немного больше, и я не уверенесли это возможно.

На изображении ниже я указал доход, а внизу - общая сумма.Итак, когда деньги поступают, флажок проверяется.

Я хотел бы сделать следующее:

Пока флажок установлен UNCHECKED , я не хочу, чтобы значение в ячейке добавлялось к общему количеству внизу.

Если это ПРОВЕРЕНО , то значение в ячейке должно быть добавлено к общему счету внизу.

Изображение 1: Нет флажков

Изображение 2: добавлены флажки

Изображение 3: установлен один флажок

Изображение 4: 2 флажки отмечены

Answer 1

Вы можете присвоить значение (например, 1 для отмеченного и 0 для непроверенного) для ячейки, в которой установлен флажок в вашей функции изменения цвета.оставьте цвет шрифта ячейки таким же, как цвет заливки ячейки, чтобы значение было невидимым для невооруженного глаза.затем в разделе общей суммы вы можете использовать функцию sumif.

Answer 2

Этого можно добиться, используя условное форматирование и формулу SUMIF, чтобы достичь этого

Я использовал следующие правила условного форматирования (Выпотребуется изменить это для ваших диапазонов)

Условное форматирование применяется как к заливке ячейки, так и к цвету текста шрифта (чтобы сделатьTrue / False быть 'невидимым')

В ячейке C6 (объединенный диапазон) у меня есть формула

=SUMIF($D$3:$D$5,TRUE,$C$3:$C$5)

Где ячейки в диапазоне D содержатзначения связанных ячеек для флажков (т. е. True, False) и диапазон C - это значения, которые вы хотите суммировать.

Это гораздо более простой подход, чем любое решение VBA и личноЯ бы удалил форматирование ячеек из вашего vba выше и просто использовал условное форматирование.

Если вы ищете способ VBA, чтобы инициировать это (за исключением формулы SUMIF)Я обновил ваш код ниже, чтобы добавить условное форматирование

Sub Insert_Checkbox_Link_Cell()
    Dim rngCel, myCells As Range
    Dim ChkBx As CheckBox
    Dim cBx As Long

    Set myCells = Selection
    myCells.NumberFormat = ";;;"

    Application.ScreenUpdating = False
    For Each rngCel In myCells
        With rngCel.MergeArea.Cells
            If .Resize(1, 1).Address = rngCel.Address Then
                Set ChkBx = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)
                With ChkBx
                    .Value = xlOff
                    .LinkedCell = rngCel.MergeArea.Cells.Address
                    .Text = ""
                    .Width = 18
                    .Top = rngCel.Top + rngCel.Height / 2 - ChkBx.Height / 2
                    .Left = rngCel.Left + rngCel.Width / 2 - ChkBx.Width / 2
                End With
            End If
        End With
    Next rngCel

    With myCells
        ' Set default value
        .Value2 = False
        ' Add conditional formatting for False value
        With .FormatConditions
            .Add Type:=xlExpression, Formula1:="=" & myCells.Cells(1).Address(False, True) & "=False"
        End With
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 9868950
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With .Font
                .Color = -6908266
                .TintAndShade = 0
            End With
        End With
        ' Add conditional formatting for True value
        With .FormatConditions
            .Add Type:=xlExpression, Formula1:="=" & myCells.Cells(1).Address(False, True) & "=True"
        End With
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 52377
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With .Font
                .Color = -16724839
                .TintAndShade = 0
            End With
        End With
    End With

    Application.ScreenUpdating = True
End Sub