【问题标题】：dropdownmenu automatically checks checkbox下拉菜单自动选中复选框
【发布时间】：2016-05-03 21:51:52
【问题描述】：

我有一个问题，我已经尝试在互联网上搜索很多，但没有找到可以帮助我的解决方案。

这是我的问题：我在单元格 J3 的 sheet3 中有一个下拉菜单（在 vba 中称为 ws_step3）。下拉菜单有 9 个选项，其中 2 个选项会自动启用一个复选框（让我们将复选框称为“咖啡杯”）

9 个选项是 A、B、C 等。

我正在寻找一个 VBA 代码，如果选中了 2 个选项，它会自动检查该复选框（假设它的 C 和 F 选中了复选框）

我使用 Active X 复选框，并使用下拉菜单

希望任何人都可以帮助我。

来自 VBA 新手的提前 TY :-)
/克劳斯

编辑 #1 - 先尝试一下

Private Sub Worksheet_Calculate()  
    If ws_Step3.Range("J3").Value = "C" Then  
    ws_Step3.CheckBoxes("Coffeecup").Value = xlOn 
    Else  
    ws_Step3.CheckBoxes("Coffeecup").Value = xlOff  
    End If  
End Sub

编辑 #2 - 感谢 DDuffy 在这方面的帮助 - 我已经在 J3 的 Private Sub Worksheet_Change(ByVal Target As Range) 中有这个

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$J$3" Then
    'Hvis værdien hedder "fremført cykelsti":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(2, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(3, 2).Value
End If

    'Hvis værdien hedder "Afkortet cykelsti":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(13, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(14, 2).Value
End If

    'Hvis værdien hedder "Venstresving fra langsiden af T-kryds":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(17, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(18, 2).Value
End If

    'Hvis værdien hedder "Cykelbane":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(21, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(22, 2).Value
End If

    'Hvis værdien hedder "Ingen cykelfaciliteter":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(27, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(28, 2).Value
End If

    'Hvis værdien hedder "Højresvingsshunt":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(31, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(32, 2).Value
End If

    'Hvis værdien hedder "Hollænderboks":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(42, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(43, 2).Value
End If

    'Hvis værdien hedder "Cykelsti i eget trace":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(46, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(47, 2).Value
End If

    'Hvis værdien hedder "Tilladt højresving for rødt":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(57, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(58, 2).Value
    End If

End If

End Sub

DDuffys 的建议来了（改成真正的问题，不再拐弯抹角）

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False

On Error GoTo Errortrap


'~~> Change it to the relevant string with which you want to compare
StringToCheck1 = "Hoejresvingsshunt"
StringToCheck2 = "Tilladt Hoejresving for roedt"


If Not Intersect(Target, Range("J3")) Is Nothing Then
    '~~> Check for the cell value
    If Target.Value = StringToCheck1 Then
    'change checkbox value to true if it matches
    Worksheets("ws_Step3").HoejreD.Value = True
    ElseIf Target.Value = StringToCheck2 Then
    'change checkbox value to true if it matches
    Worksheets("ws_Step3").HoejreD.Value = True
    Else
    'change checkbox value to false if it doesn't match
    Worksheets("ws_Step3").HoejreD.Value = False
    End If
End If

LetsContinue:
   Application.EnableEvents = True
   Exit Sub
Errortrap:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

我现在的问题是，如何将这些合并到工作表更改中？

我在这里有一张我的工作表的图片：http://imgur.com/D4NXDI8

【问题讨论】：

到目前为止你尝试过什么？尝试是有趣的部分。您想考虑您的伪代码，然后尽可能多地将其转换为 VBA。所以你会想要一些类似的东西：如果 ws_steps.Text 等于“C”和“F”，那么 CheckBoxName.Value 等于 true。尝试将其转换为 VBA 并向我们展示您所拥有的。这里的人不会为你做你的工作，但如果你遇到困难，有很多人会有所帮助。
忘了提及，如果您选择了选项 C/F 并希望从下拉菜单中重新选择任何选项 A 或 B，则应再次取消选中该复选框，但仅适用于选项 A 或 B，如果它已经从选择 C/F 中被选中，则其余部分应保持选中状态。
试过这个： Private Sub Worksheet_Calculate() If ws_Step3.Range("J3").Value = "C" Then ws_Step3.CheckBoxes("Coffeecup").Value = xlOn Else ws_Step3.CheckBoxes(" Coffeecup").Value = xlOff End If End Sub
你最好用你尝试过的东西而不是在 cmets 中编辑问题。
完成，感谢您为我解决这个问题 :-)

标签： vba excel checkbox

【解决方案1】：

归功于 Marc L 的问题是为此提供构建块。

这应该可以工作，假设它是一个数据验证下拉框。

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub

Application.EnableEvents = False

On Error GoTo Errortrap


'~~> Change it to the relevant string with which you want to compare
StringToCheck1 = "C"
StringToCheck2 = "F"


If Not Intersect(Target, Range("J3")) Is Nothing Then
    '~~> Check for the cell value
    If Target.Value = StringToCheck1 Then
      'change checkbox value to rue if it matches
       Worksheets("ws_Step3").Coffeecup.Value = True
       ElseIf Target.Value = StringToCheck2 Then
      'change checkbox value to true if it matches
       Worksheets("ws_Step3").Coffeecup.Value = True
       Else
      'change checkbox value to false if it doesn't match
       Worksheets("ws_Step3").Coffeecup.Value = False
    End If
End If

LetsContinue:
   Application.EnableEvents = True
   Exit Sub
Errortrap:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

当在下拉菜单中选择 C 或 F 时，这会将复选框更改为 true（或勾选）。

编辑

好的，我想我明白了，（同样，无需重新创建原始工作表或无法读取您的 cmets，这只是“应该工作”的领域）。

If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False

On Error GoTo Errortrap


'~~> Change it to the relevant string with which you want to compare
StringToCheck1 = "Hoejresvingsshunt"
StringToCheck2 = "Tilladt Hoejresving for roedt"


If Not Intersect(Target, Range("J3")) Is Nothing Then
    '~~> Check for the cell value
    If Target.Value = StringToCheck1 Then
    'change checkbox value to true if it matches
    Worksheets("ws_Step3").HoejreD.Value = True
    ElseIf Target.Value = StringToCheck2 Then
    'change checkbox value to true if it matches
    Worksheets("ws_Step3").HoejreD.Value = True
    Else
    'change checkbox value to false if it doesn't match
    Worksheets("ws_Step3").HoejreD.Value = False
    End If
    
        'Hvis værdien hedder "fremført cykelsti":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(2, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(3, 2).Value
    End If

    'Hvis værdien hedder "Afkortet cykelsti":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(13, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(14, 2).Value
    End If

    'Hvis værdien hedder "Venstresving fra langsiden af T-kryds":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(17, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(18, 2).Value
    End If

    'Hvis værdien hedder "Cykelbane":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(21, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(22, 2).Value
    End If

    'Hvis værdien hedder "Ingen cykelfaciliteter":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(27, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(28, 2).Value
    End If

    'Hvis værdien hedder "Højresvingsshunt":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(31, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(32, 2).Value
    End If

    'Hvis værdien hedder "Hollænderboks":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(42, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(43, 2).Value
    End If

    'Hvis værdien hedder "Cykelsti i eget trace":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(46, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(47, 2).Value
    End If

    'Hvis værdien hedder "Tilladt højresving for rødt":
    If ws_Step3.Cells(3, 10).Value = WS_DDL.Cells(57, 2).Value Then
    'Default value sættes til det første i dropdown
    ws_Step3.Cells(8, 12).Value = WS_DDL.Cells(58, 2).Value
    End If
    
End If

LetsContinue:
   Application.EnableEvents = True
   Exit Sub
Errortrap:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

【讨论】：

嗯，它不起作用，试图编辑我在原始问题中所做的事情
当您打开 VBA 编辑器时，双击项目窗口（左上角）中的工作表名称（例如“Sheet1(ws_Step3)”）添加代码。确保您的下拉列表位于单元格“J3”中或更改代码中的引用。确保所有名称都正确，即 Coffeecup 等。此外，是否使用“数据验证”添加了下拉列表？
下拉列表是使用数据验证添加的，是的
它需要添加到工作表后面的代码中并带有下拉菜单，因为它正在检查页面的更改。如果下拉菜单是 Data Validation 并且它是一个 activeX 复选框，那么这个“应该”工作。检查代码中的对象名称和范围是否与您的工作簿匹配，并确保您将代码放在正确的位置查看添加到我的答案中的图像
我的 sheet3 中已经有一个“Private Sub Worksheet_Change(ByVal Target As Range)”，它需要放在同一个 sub 中，还是可以单独使用？

【解决方案2】：

我认为您没有“sheet3 中的下拉菜单”，但您有一个下拉组合框，您可以在其中选择某些内容并将其用作菜单。

使用组合框，您可以使用 Change 事件来检测选择。然后，您将获得已选择的内容，并据此执行您的操作。

Private Sub object_Change( )

object 是组合框的名称。

【讨论】：

你是对的，我的下拉选择位于另一个工作表中，称为“WS_DDL”据我所知，我没有使用组合框，我在工作表 3 中的单元格 J3 上使用数据验证。 J3 中的下拉菜单来自我在下拉表中提供的命名范围。我不完全确定您的解决方案是什么意思，因为我对 VBA 很陌生。你能详细说明一下吗？