如何在Excel中創建動態下拉列表

我有一個電子表格，我正在嘗試創建一個動態下拉列表。我已將其設置爲使我有一個列表Test No.和下一週的下一天到它。它看起來像這樣：如何在Excel中創建動態下拉列表

現在我想的是，我想在下拉列表中列出的一個下添加相同數量只給我的，尚未使用的可用天數。

即對1234下拉下的新要有周四，週五，週六，週日即對5678下拉下的新應該有周一，週三，週四，週六，週日即對9012新下的下拉應該有星期六，星期日

我有一個命名的範圍，有7天的一週，我可以使用數據驗證有這個名單是下拉選項，但我希望它是動態的，只給我Test No尚未使用的選項。

可以這樣做嗎？

2017-04-21 Mike

假設你的數據在列A：B，其中ROW1爲標題行和你調用一個名爲範圍天然後用鼠標右鍵單擊工作表標籤 - >查看代碼並粘貼下面給出入代碼打開代碼窗口 - >將工作簿保存爲啓用宏的工作簿。

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
If Target.CountLarge > 1 Then Exit Sub 
Dim x, dict 
Dim i As Long, lr As Long 
Dim Rng As Range, Cell As Range 
Dim Str As String 
lr = Cells(Rows.Count, 1).End(xlUp).Row 
Set Rng = Range("A2:A" & lr) 
x = Range("Days").Value 
Set dict = CreateObject("Scripting.Dictionary") 
If Target.Column = 2 And Target.Row > 1 Then 
    If Target.Offset(0, -1) <> "" Then 
     For Each Cell In Rng 
      If Cell <> "" And Cell = Target.Offset(0, -1) Then 
       If Str = "" Then 
        Str = Cell.Offset(0, 1).Value 
       Else 
        Str = Str & ", " & Cell.Offset(0, 1).Value 
       End If 
      End If 
     Next Cell 
     For i = 1 To UBound(x, 1) 
      If InStr(Str, x(i, 1)) = 0 Then 
       dict.Item(x(i, 1)) = "" 
      End If 
     Next i 
     On Error Resume Next 
     With Target.Validation 
      .Delete 
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ 
           xlBetween, Formula1:=Join(dict.keys, ",") 
     End With 
    End If 
End If 
End Sub

所以一旦你選擇B列的單元格，代碼將添加一個下拉列表中排除已選定的特定測試無天。列A中的相應單元格

來源

2017-04-21 21:09:54 sktneer

您可以根據使用下拉列表
創建列表週一 - 週日定義名稱wkday例如
選擇週二 - 週日和定義名稱週一
選擇週三 - 週日和定義名稱週二
選擇週四 - 週日和定義名稱週三
選擇週五 - 週日和定義名稱週四
選擇週六 - 週日和定義名稱週五
選擇週日和定義名稱週六

您可以選擇所有單元格在您需要的下拉列表：
帶小區B2例如啓動下面創建數據驗證，列表，在源寫：

=IF(OR(B1="",B1="Day"),wkday,INDIRECT(B1))

來源

2017-04-21 19:44:39 yass

這隻會覆蓋它，如果他們總是按順序。有時候他們不喜歡'9012'，因爲它是在Mon和Wed之間挑選的，所以我最終需要Tue，Sat，Sun。 – Mike

如果您選擇週一下週三，下面的單元格會列出週四 - 週日（名稱週三） – yass

您可以在紙張的代碼模塊來改變validat在處理Worksheet_SelectionChange事件離子列表。一些檢查是必要的，以查看新選中的單元格是否是您想要驗證的單元格之一;即列B，列A中的標識符等。下面例程中的檢查符合你的示例數據。

' Code Module of your worksheet 
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    If Target.Cells.count > 1 Then Exit Sub 
    If Target.Column <> 2 Or Target.row < 2 Then Exit Sub 
    If Len(Trim(Target.Value)) > 0 Then Exit Sub 
    If Len(Trim(Target.offset(, -1).Value)) = 0 Then Exit Sub 

    Dim newList As String: newList = ",Sun,Mon,Tue,Wed,Thu,Fri,Sat" 
    Dim r As Range: Set r = Target.offset(-1) 
    Do Until Len(Trim(r.Value2)) = 0 Or r.offset(, -1).Value2 <> Target.offset(, -1).Value2 
     newList = Replace(newList, "," & r.Value2, "") 
     Set r = r.offset(-1) 
    Loop 
    With Target.Validation 
     .Delete 
     .Add xlValidateList, , , Mid(newList, 2) 
    End With 
End Sub

來源

2017-04-21 20:12:45

如何在Excel中創建動態下拉列表

回答

相關問題