Excel VBA-如果选中复选框，则将单元格值添加到总和

我不确定标题是否准确地描述了我的查询，因此我将在这里尽力描述它

我有一张记录费用和收入的工作表，我有一个宏，我用它将复选框插入选定的单元格，将复选框链接到这些单元格，最后，一旦选中复选框，以及再次取消选中复选框，就为条件格式应用条件

下面是实现此目的的代码：

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

功能：

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

因此，这是如何工作的，我选择我想有复选框的单元格范围，然后我运行宏，它插入复选框，如上所述

---

现在我想补充一点，我不确定这是否可能

在下图中，我列出了收入，底部是总收入。因此，当钱进来时，复选框被选中

我想做的是：

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

当复选框未选中时，我不希望单元格中的值添加到底部的总计数中

选中时，单元格中的值应添加到底部的总计数中

图1：无复选框

图2：添加复选框

图3：选中一个复选框

图4：选中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

---

您可以使用条件格式和

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

您可以为在颜色更改函数中添加复选框的单元格指定一个值（例如：1表示选中，0表示未选中）。保持单元格的字体颜色与单元格的填充颜色相同，以便肉眼看不到该值。然后在total sum部分中，可以使用sumif函数

您可以为在颜色更改函数中添加复选框的单元格指定一个值（例如：1表示选中，0表示未选中）。保持单元格的字体颜色与单元格的填充颜色相同，以便肉眼看不到该值。然后在total sum部分中，可以使用sumif函数

---

“现在我想再添加一点，我不确定是否可能”是的，是的。有许多方法来完成这项任务；您的首选路径是什么？您在上述方向上做了哪些工作？如果您需要提示（这可能不是正确的论坛），我建议使用VBA循环并求和X（其中X是您的值），如果复选框为.value=true，则y=X+y，其中y是您循环时X的和。@Cyril感谢您的评论。我问1）这是否可能，因为我不确定我已经创建的宏是否仍然可以将此函数/功能添加到单元格中2）来自经验更丰富的用户的一点指导（如您所说，可能不是正确的形式），3）希望有人能给我一个代码片段开始。在阅读了Tom最初的评论之后，我意识到我没有清晰地思考，因为我已经在牢房里有了一个条件检查，我可以修改它，很高兴你找到了答案；当我输入我的建议时，我不得不选择SUMIFS或Loop，然后选择Loop（如果有自由浮动控件，Loop将能够关联，而SUMIFS非常简单）。“干杯，祝你有一个美好的一天。”现在我想补充一点，我不确定这是否可能“是的，是的。有许多方法来完成这项任务；您的首选路径是什么？您在上述方向上做了哪些工作？如果您需要提示（这可能不是正确的论坛），我建议使用VBA循环并求和X（其中X是您的值），如果复选框为.value=true，则y=X+y，其中y是您循环时X的和。@Cyril感谢您的评论。我问1）这是否可能，因为我不确定我已经创建的宏是否仍然可以在单元格中添加此函数/功能2）从更多用户那里获得一些指导