1

我不是真正的 VBA 专家，我的代码有问题，我不知道如何解决。（代码来自：http ://siddharthout.wordpress.com/2011/07/29/excel-data-validationcreate-dynamic-dependent-lists-vba/ ）

我正在使用 8 个动态依赖列表，并且我认为如果我修改列表，那么自动化该过程并避免在将来修改宏的最佳方法是 VBA 代码。

试图找到正确的代码，我只是在处理列表。之后，将其应用于所有列表。

我检查了代码，发现存在错误（对象“_global”的方法“相交”失败），因为我正在比较来自不同工作表的两个范围。

我的代码是：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Long, LastRow As Long, n As Long
Dim MyCol As Collection
Dim SearchString As String, Templist As String

Application.EnableEvents = False

On Error GoTo Whoa

' Find LastRow in Col A
LastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row

If Not Intersect(Target, Sheet2.Columns(1)) Is Nothing Then
Set MyCol = New Collection

' Get the data from Col A into a collection
For i = 2 To LastRow
    If Len(Trim(Sheet2.Range("A" & i).Value)) <> 0 Then
        On Error Resume Next
        MyCol.Add CStr(Sheet2.Range("A" & i).Value), CStr(Sheet2.Range("A" & i).Value)
        On Error GoTo 0
    End If
Next i

' Create a list for the Data Validation List
For n = 1 To MyCol.Count
    Templist = Templist & "," & MyCol(n)
Next

Templist = Mid(Templist, 2)

Range("A2").ClearContents: Range("A2").Validation.Delete

' Create the Data Validation List
If Len(Trim(Templist)) <> 0 Then
    With Range("A2").Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Templist
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End If

' Capturing change in cell A2
ElseIf Not Intersect(Target, Range("A2")) Is Nothing Then
SearchString = Range("A2").Value

Templist = FindRange(Sheet2.Range("A2:A" & LastRow), SearchString)

Range("B2").ClearContents: Range("B2").Validation.Delete

If Len(Trim(Templist)) <> 0 Then
    ' Create the DV List
    With Range("B2").Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Templist
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End If
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub

' Function required to find the list from Col B
Function FindRange(FirstRange As Range, StrSearch As String) As String
Dim aCell As Range, bCell As Range, oRange As Range
Dim ExitLoop As Boolean
Dim strTemp As String

Set aCell = FirstRange.Find(what:=StrSearch, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:= _
xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

ExitLoop = False

If Not aCell Is Nothing Then
    Set bCell = aCell
    strTemp = strTemp & "," & aCell.Offset(, 1).Value
    Do While ExitLoop = False
        Set aCell = FirstRange.FindNext(After:=aCell)

        If Not aCell Is Nothing Then
            If aCell.Address = bCell.Address Then Exit Do
            strTemp = strTemp & "," & aCell.Offset(, 1).Value
        Else
            ExitLoop = True
        End If
    Loop
    FindRange = Mid(strTemp, 2)
End If
End Function

进入Sheet1，我只想让单元格选择列表选项，进入Sheet2，我想要所有动态和依赖列表。

是否有可能使用这些算法比较来自不同工作表的两个范围？或者为 8 个依赖和动态列表创建选择列表的替代代码？

4

1 回答 1

0

我将带你到这个页面，这个页面很好地描述了动态依赖列表的用法。 动态依赖列表

也许您根本不需要 VBA，除非您必须即时更改这些内容，或者基于其他一些变量。最好先使用 Excel 的内置功能，然后再使用代码。

如果您正在徘徊，您可以通过将命名范围范围设置为整个工作簿来绕过在两个不同工作表上的列表。

编辑：添加对直接 VBA 错误的答案。

既然您没有说，不确定您的 Intersect 是否在这里中断：

If Not Intersect(Target, Sheet2.Columns(1)) Is Nothing Then

但我认为是。试试这个：

If Not Intersect(Target, Columns(1).EntireColumn) Is Nothing Then
于 2012-05-15T15:29:26.010 回答