带有下拉列表的循环引用

时间:2014-05-22 15:14:10

标签: excel excel-vba vba

MS可以吗? Excel或VBA是否具有带有下拉列表的循环引用?

以下是我所追求的内容:我想在两张纸(表1,表2)上生成一个下拉列表,其中显示“完成”或“未完成”。如果我将表格1从完全更改为不完整,我希望表单2说同样的事情,但我也希望反之亦然 (如果我将工作表2从完成更改为不完整,我希望工作表1更改。)

这可能吗?

3 个答案:

答案 0 :(得分:5)

根据任何工作表的变化采取措施' B5范围似乎是一种可行的方法,但单个Worksheet_Change事件宏有一些限制。

必须在许多工作表代码表中重复代码,并且必须克隆任何修改。新工作表要求将子过程合并到他们自己的代码表中。

在编写新值之前不禁用事件,接收新值的每个工作表将启动自己的Worksheet_Change事件宏,而宏将重写将触发更多事件的值。级联事件失败几乎肯定会发生。

通过将Worksheet_Change事件宏替换为位于 ThisWorkbook 代码表中的更通用的Workbook_SheetChange事件宏,可以将所有代码本地化到一个位置。调整在一个地方进行,新工作表将自动添加到要处理的工作表队列中。它们可以很容易地添加到工作表而不是的数组中以进行处理。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Address = "$B$5" And Sh.Name <> "Sheet3" Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False
        Dim w As Long
        For w = 1 To Worksheets.Count
            With Worksheets(w)
                'skip this worksheet and Sheet3
                If CBool(UBound(Filter(Array(Sh.Name, "Sheet3"), _
                        .Name, False, vbTextCompare))) Then
                    .Range("B5") = Target.Value
                    '.Range("B5").Interior.ColorIndex = 3  '<~~testing purposes
                End If
            End With
        Next w
    End If
bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

任何不接收其自身B5单元格中的值更新的工作表都可以添加到Filter function中使用的数组中。目前,Sheet3和启动Workbook_SheetChange事件的工作表将被排除。

答案 1 :(得分:3)

我会创建一个隐藏的工作表,其中包含输入和链接单元格的范围。然后将下拉列表链接到列表和链接的单元格。然后,当你改变一个,它将改变另一个。这里的关键是Linked Cell。这是假设Excel 2013,使用表单控件组合框。

答案 2 :(得分:3)

请查看@Jeeped's answer,因为这是最有效的答案。

<小时/> 经过一些试验和错误后,我已经使用了一个带有“数据验证”下拉菜单的单元格。在我的测试用例中,我有3张带有数据验证列表的单据$ B $ 5,每张工作表链接到隐藏表单上的列表以填充列表,带有选项列表的表单是“Sheet3”并且不包含数据验证清单。

以下代码需要复制到每个工作表模块。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    If Target.Address = "$B$5" Then
        For Each ws In ThisWorkbook.Worksheets
            If Not ws.Name = Me.Name And Not ws.Name = "Sheet3" Then
                If Not ws.Range(Target.Address) = Me.Range(Target.Address) Then
                    ws.Range(Target.Address) = Me.Range(Target.Address)
                End If
            End If
        Next ws
    End If
End Sub

使用表格上的activeX组合框

非常容易

在工作簿模块上添加以下代码以填充组合框

Private Sub Workbook_Open()
    With ThisWorkbook
        With .Worksheets("Sheet1").ComboBox1
            .AddItem "Complete"
            .AddItem "Incomplete"
        End With
        With .Worksheets("Sheet2").ComboBox1
            .AddItem "Complete"
            .AddItem "Incomplete"
        End With
    End With
End Sub

在“Sheet1”模块上添加

Private Sub ComboBox1_Change()
    If Me.ComboBox1 = "Complete" Then
        ThisWorkbook.Worksheets("Sheet2").ComboBox1.Value = "Complete"
    ElseIf Me.ComboBox1 = "Incomplete" Then
        ThisWorkbook.Worksheets("Sheet2").ComboBox1.Value = "Incomplete"
    End If
End Sub

在“Sheet2”模块上添加

Private Sub ComboBox1_Change()
    If Me.ComboBox1 = "Complete" Then
        ThisWorkbook.Worksheets("Sheet1").ComboBox1.Value = "Complete"
    ElseIf Me.ComboBox1 = "Incomplete" Then
        ThisWorkbook.Worksheets("Sheet1").ComboBox1.Value = "Incomplete"
    End If
End Sub