Question

我有以下情况：

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

我发现这个有趣，所以检查一下......应该像你期望的那样工作...... 将此代码发布到您的工作表中，并根据您的需要进行调整（如有必要）。希望它有所帮助。

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 2

我的思考过程是：

首先列出我们需要比较的所有范围：
- 细胞（1,1）不应出现在范围内（细胞（1,4），细胞（1,4））
- 细胞（2,1）不应出现在范围内（细胞（1,4），细胞（2,4））
- 单元格（3,1）不应出现在范围（单元格（1,4），单元格（3,4）） ...等...
足够简单。现在我们知道要比较的范围，循环比较：
- 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

它应该很容易适应您的需求，或者如果没有，有很多现有的解决方案＆amp;资源，甚至是 Stack Overflow 标记：cascadingdropdown

Answer 3

这是一种方法：

在工作表中选择一个可用于命名范围的列（可以隐藏此列）。出于以下示例的目的，我使用了列request failure with http statusCode:400,exception:org.apache.http.client.HttpResponseException: Bad Request request failed with server response:{"name":"UNSUPPORTED_PAYEE_CURRENCY","details":[],"message":"The currency is not acceptedbypayee.","information_link":"https://developer.paypal.com/docs/api/payments/#errors","debug_id":"b5cb9cc041f7b"} UNSUPPORTED_PAYEE_CURRENCY，我的命名范围称为 J 。我还假设工作表中的值从第2行开始。

现在在一个模块中，添加以下子项：

ValidationRange

现在在工作表中发生变化时调用此函数..就像这样：

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 ）为Data Validation列中的单元格设置A具有权限

现在每次在ValidationRange列中选择一个值时，它都会从命名范围中删除该值，从而从您的下拉框中删除

在VBA验证中获取动态下拉列表

3 个答案: