Question

我正在尝试将VBA用于我的最后一年项目。但是，我遇到了一些困难。

我正在尝试使用Excel VBA来引用我使用具有自己特定颜色的部门名称编码的工作表。例如，红色部门“CLR”。我希望如果我要去另一张纸，并使用下拉列表选择我想要的部门，它将根据我从第一张纸上设置的颜色而改变。

对于我编码的工作表，我将在下面和图片文件中添加。因为我在VBA中很弱，所以请引导我。

Private Sub Worksheet_Change(ByVal Target As Range)

    Set i = Intersect(Target, Range("A1:Z10000"))
    If Not i Is Nothing Then
        Select Case Target
            Case "CLR": NewColor = 3
            Case "CTS": NewColor = 4
            Case "OMS": NewColor = 5
            Case "ENT": NewColor = 6
            Case "O&G": NewColor = 7
            Case "HND": NewColor = 8
            Case "SUR_ONCO": NewColor = 9
            Case "NES": NewColor = 10
            Case "OTO": NewColor = 11
            Case "PLS": NewColor = 12
            Case "BREAST": NewColor = 13
            Case "UGI": NewColor = 14
            Case "HPB": NewColor = 15
            Case "VAS": NewColor = 16
            Case "H&N": NewColor = 17
            Case "URO": NewColor = 18
            Case "OPEN": NewColor = 19
        End Select
        Target.Interior.ColorIndex = NewColor


    End If


End Sub

更新2：过滤表

当我输入我的部门时，我决定使用文本框来过滤我的数据。但是，每当我输入部门名称时，我都会遇到一些麻烦。你能帮我解决一下我的问题吗？

Private Sub TextBox1_Change()

    Dim Text

    Text = TextBox1.Value

    If Text <> "" Then
        Sheet2.Range("C7:AV26").AutoFilter Field:=1, Criteria1:="Text,_", VisibleDropDown:=False

    Else:
        Sheet2.AutoFilterMode = False

    End If

End Sub

Answer 1

我对你的例子做了几个假设，但如果它不完全是你所需要的，我希望你能适应它。我设置了以下范围：

然后，在Allocation工作表上，单个下拉单元格使用Cell C2上的数据验证来使用List中的=Legend!C2:C6进行验证：

我的假设是，您希望为Legend工作表中的每个项目选择的颜色用于设置Allocation工作表上的下拉单元格。在您的代码中，您已将颜色硬编码为VBA - 这意味着如果您想要更改颜色，则必须修改代码。下面的示例将在下拉列表中找到用户的选择，并获取该单元格的当前颜色以将其应用于下拉单元格。这样，如果您想重新制作颜色，则根本不需要修改您的VBA代码。

Worksheet_Change工作表的Allocation事件代码如下所示：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$C$3" Then
        Dim legendWS As Worksheet
        Dim legendCell As Range
        Set legendWS = ThisWorkbook.Sheets("Legend")

        Set legendCell = legendWS.Range("C2:C6").Find(Target.Value)
        If Not legendCell Is Nothing Then
            Target.Interior.Color = legendCell.Interior.Color
        End If
    End If
End Sub

将工作表1（图例）中的单元格引用到工作表2（分配）

1 个答案: