如何在Excel 2016中使用VBA创建相关下拉菜单？

Question

我想创建在下列工作表（规划）的B列下拉：

的D3细胞包含要显示的语言。在列A中输入尺寸标注时，我想要按下输入的尺寸标注过滤部件。

的数据包含在下面的工作表（数据）：

更为复杂的是，我想下拉从取决于规划选定语言的数据表显示内容$ D3（如果选择英文显示绿色文字，如果选择日文显示红色文字）。下拉列表中只会出现带有维度和标签==“索引”的行（2，8，15，...）。选择后，下拉菜单应显示零件数据（蓝色）。

如何在VBA中创建这样的下拉菜单？

Answer 1

这是一个有趣的问题，我得到了下面的代码使用在B列的单元格设置验证方法时，列A

B列中的文本的颜色输入了二维码工作在选择选项后变为蓝色，但您想要的绿色和红色文本并不是真的可行，因为在单元格内下拉列表中总是显示黑色，而不管单元格的字体颜色如何。

该代码并不完美，但更多的只是一个概念证明和一些让你大开局的东西。

Dim CHANGING_VAL As Boolean 'Global Variable that can be set to prevent the onchange being fired when the Macro is removing the description from the dropdown. 

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 


    If Target.Column = 2 And CHANGING_VAL = False Then 
     CHANGING_VAL = True 
     If InStr(1, Target.Value, "~") > 2 Then 
      Target.Value = Left(Target.Value, InStr(1, Target.Value, "~") - 2) 
     End If 
     Target.Validation.Delete 
     Target.Font.Color = RGB(0, 0, 255) 
     CHANGING_VAL = False 
    End If 

End Sub 

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 
    If Target.Column = 2 Then 
     If Target.Offset(0, -1) <> "" Then 
      strValidList = "" 
      For intRow = 1 To 300 
       If Sheets("Data").Cells(intRow, 1) = Target.Offset(0, -1) Then 
        If Sheets(Target.Parent.Name).Cells(3, 4) = "English" Then 
         strValidList = strValidList & Sheets("Data").Cells(intRow, 2) & " ~ " & Sheets("Data").Cells(intRow, 3) & ", " 
        Else 
         strValidList = strValidList & Sheets("Data").Cells(intRow, 2) & " ~ " & Sheets("Data").Cells(intRow, 4) & ", " 
        End If 
       End If 
      Next 

      If strValidList <> "" Then 
       strValidList = Left(strValidList, Len(strValidList) - 2) 

       Target.Select 

       With Selection.Validation 
        .Delete 
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=strValidList 
        .IgnoreBlank = True 
        .InCellDropdown = True 
        .InputTitle = "" 
        .ErrorTitle = "" 
        .InputMessage = "" 
        .ErrorMessage = "" 
        .ShowInput = True 
        .ShowError = True 
       End With 
      End If 
     End If 
    Else 
     Sheets(Target.Parent.Name).Range("B:B").Validation.Delete 
    End If 

End Sub