修改

Question

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

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

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

我正在寻找一个VBA代码，如果选中其中两个选项，则会自动检查该复选框（让我们说它的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帮助解决这个问题 - 我已经在我的Private Sub Worksheet_Change（ByVal Target As Range）中为J3

了

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

Answer 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（或勾选）。

修改

好吧，想想得到它，（再次，没有重新创建原始表格或能够阅读你的评论，这只是“应该工作”的领域）。

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

Answer 2

我认为你没有“在sheet3中有一个下拉菜单”，但是你有一个下降的组合框，你可以在其中选择一些东西并将其用作菜单。

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

Private Sub object_Change( )

其中object是组合框的名称。

dropdownmenu会自动检查复选框

2 个答案:

修改