复选框的Excel VBA矩阵 - 列AND行中只有一个(?)

时间:2015-06-15 10:51:23

标签: excel vba excel-vba checkbox

我的问题的一句话摘要听起来很熟悉:

  

我有一个复选框的“矩阵”,我希望它们的行为类似于单选按钮。

但是:请不要告诉我改为使用radio buttons,除非您知道如何按照检查其中一个的方式对其进行分组,可以在同一行和列中选择NO OTHER按钮

我有一列项目,每个项目都有3个复选框,如下所示:

player  C   A1  A2
------------------
item1  [ ] [ ] [ ]
item2  [ ] [ ] [ ]
item3  [ ] [ ] [ ]
item4  [ ] [ ] [ ]
item5  [ ] [ ] [ ]
item6  [ ] [ ] [ ]
item7  [ ] [ ] [ ]
...
itemN  [ ] [ ] [ ]

为了便于解释,我们假设这些项目代表曲棍球队的球员,并且您想要命名您的队长和助理队长。 在理想的世界中,您将选择3名玩家(1名队长C,2名替补队长A1A2)。在哪种情况下,以下规则始终适用:

1. One player cannot hold more than one role
2. The same role cannot be assigned to more than one person.

因此,如果我选择player3作为队长,我希望将其视为结果

player  C   A1  A2
------------------
item1      [ ] [ ]
item2      [ ] [ ]
item3  [x]        
item4      [ ] [ ]
item5      [ ] [ ]
item6      [ ] [ ]
item7      [ ] [ ]
...

没有一些令人讨厌的编码,这是可行的吗?因为它有令人讨厌的编码,所以我不确定它是否值得所有的努力。

(另外,我不一定非常喜欢这些东西,但是我想要一些比这更好的东西:

player  
-------------
item1    [ ]
item2    [ ]
item3    [C]
item4    [ ]
item5    [A]
item6    [A]
item7    [ ]
...

因为首先,我仍然想要有点花哨,其次,选中复选框也应该执行其他操作。)

1 个答案:

答案 0 :(得分:0)

这个代码片段放在您希望拥有复选框的工作表代码中应该可以解决这个问题:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Dim r As Range: Set r = Sheet1.Range("B2:E10")

  If Not Intersect(r, Target) Is Nothing Then
    If Target.CountLarge = 1 Then
      If Target = "[x]" Then
        Target = [ ]
        Intersect(Sheet1.Rows(Target.Row), r) = "[ ]"
        Intersect(Sheet1.Columns(Target.Column), r) = "[ ]"
      Else
        Intersect(Sheet1.Rows(Target.Row), r).ClearContents
        Intersect(Sheet1.Columns(Target.Column), r).ClearContents
        Target = "[x]"
      End If
    End If
  End If

  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

请注意,您要执行此操作的工作表的代号必须为“Sheet1”,并且您需要在子工作顶部的set语句中定义包含复选标记的范围的名称。