在VBAvalidation中获取dynamic下拉列表

我有以下情况：

1.Column D populated with about 100 values, 2. Using these I create a validation in the Column A cells 3. If I have a value in Cell "A1", this particular value should not appear in Cell "A2" dropdown list, now the values in "A1" and "A2" should not appear in "A3" and so on. 

为此编写VBA代码的思路应该是什么？

Answer 1

我的思考过程是：

1. 第一个循环列出我们需要比较的所有范围：

   • 单元格（1,1）不应出现在范围（单元格（1,4），单元格（1,4））

   • 单元格（2,1）不应出现在范围（单元格（1,4），单元格（2,4））

   • 单元格（3,1）不应出现在范围（单元格（1,4），单元格（3,4）） 等…

2. 很简单。 现在我们知道要比较哪些范围，循环比较：

   • re： Cells(3,1) should not appear in Range(Cells(1,4),Cells(3,4)) ：

。

 Dim c as range For Each c in Range(Cells(1,4),Cells(3,4)) If c.Value = Cells(1,4).Value then 'it's a match! Delete it (or whatever) c.Value = "" End If Next c 

最后，把两个循环放在一起…

---

根据我所了解的你的描述，我想出了这个：

 Sub compareCells() Dim c As Range, x As Integer For x = 1 To 10 Debug.Print "Cells(" & x & ",1) should not appear in Range(Cells(1,4),Cells(" & x & ",4))" For Each c In Range(Cells(1, 4), Cells(x, 4)) Debug.Print "compare " & Cells(x, 1).Address & " to " & c.Address If Cells(x, 1).Value = c.Value Then Cells(x, 1).Cells.Font.Color = vbBlue End If Next c Next x End Sub 

它应该很容易适应你的需要，否则，有很多现有的解决scheme和资源，即使是堆栈溢出标签： cascadingdropdown

Answer 2

我发现这一个有趣的，所以检查了这一点…应该如你所愿地工作…发布这个代码到你的工作表，并适应您的需要（如有必要）。 希望能帮助到你。

 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim dict As Object Dim dictAlreadyTaken As Object Dim valueRange As Range Dim targetRange As Range Dim cell As Object Dim Key As Variant Dim currentList() As Variant Dim i As Integer If Target.Column = 1 Then Set ws = Worksheets(1) Set dict = CreateObject("Scripting.Dictionary") Set dictAlreadyTaken = CreateObject("Scripting.Dictionary") Set valueRange = ws.Range("D:D") Set targetRange = ws.Range("A:A") For Each cell In valueRange If cell.Value <> "" Then dict.Add cell.Value, cell.Row Else Exit For End If Next cell For Each cell In targetRange If cell.Row <= dict.Count Then If cell.Value <> "" Then 'ad the value taken dictAlreadyTaken.Add cell.Value, cell.Row End If Else Exit For End If Next cell For Each cell In targetRange If cell.Row <= dict.Count Then 'add this list Erase currentList ReDim currentList(0) i = 0 ws.Cells(cell.Row, 1).Validation.Delete For Each Key In dict.keys If Not dictAlreadyTaken.exists(Key) Then i = i + 1 ReDim Preserve currentList(i) As Variant currentList(i) = Key End If Next Key If UBound(currentList) > 0 Then ws.Cells(cell.Row, 1).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(currentList, ",") End If Else Exit For End If Next cell End If End Sub 

Answer 3

这是一个方法：

在工作表中select一个可用于命名范围的列（此列可以隐藏）。 为了下面的例子，我使用了J列，我命名的范围叫做ValidationRange 。 我还假定您的工作表中的值从第2行开始。

现在在一个模块中，添加下面的子节点：

 Sub SetDropDownRange() Dim oNa As Name: Set oNa = ThisWorkbook.Names.Item("ValidationRange") Dim iLR&, iC&, iLRJ& Dim aDRange As Variant Dim aVRRange As Variant With ThisWorkbook.Worksheets("Sheet12") iLR = .Range("D" & .Rows.count).End(xlUp).Row iLRJ = .Range("J" & .Rows.count).End(xlUp).Row aDRange = Range("D2:D" & iLR) For iC = LBound(aDRange) To UBound(aDRange) If Len(Trim(aDRange(iC, 1))) <> 0 Then If Application.WorksheetFunction.CountIf(Range("A:A"), aDRange(iC, 1)) = 0 Then If IsArray(aVRRange) Then ReDim Preserve aVRRange(UBound(aVRRange) + 1) Else ReDim aVRRange(0) End If aVRRange(UBound(aVRRange)) = aDRange(iC, 1) End If End If Next End With Range("J2:J" & iLRJ).Value = "" Range("J2:J" & UBound(aVRRange) + 2).Value = Application.Transpose(aVRRange) oNa.RefersTo = oNa.RefersToRange.Resize(UBound(aVRRange) + 1, 1) End Sub 

现在当你的工作表发生变化的时候调用这个函数就像这样：

 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Or Target.Column = 4 Then SetDropDownRange End If End Sub 

使用命名范围（本例为ValidationRange为列A的单元格设置Data Validation

现在，每当您在列Aselect一个值时，它将从命名范围中删除该值，从而从下拉框中删除该值