如何在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