VBA中分离的工作表中的动态依赖列表 [英] Dynamic Depending Lists in Separated WorkSheets in VBA

问题描述

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

我' m使用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，模板作为字符串
 
 Application.EnableEvents = False 
 
错误GoTo Whoa 
 
'在Col A 
 LastRow = Sheet2中查找LastRow。范围（A& Rows.Count）.End（xlUp）.Row 
 
如果不相交（目标，Sheet2.Columns（1））没有，然后
设置MyCol =新收集
 
'从Col A获取数据到集合
对于i = 2 To LastRow 
如果Len（Trim（SheetA.Range（A& i））。值））< 0然后
 On Error Resume Next 
 MyCol.Add CStr（Sheet2.Range（A& i）.Value），CStr（Sheet2.Range（A& i）.Value） 
错误GoTo 0 
结束如果
下一个i 
 
'为数据验证列表创建一个列表
对于n = 1到MyCol.Count 
 Templist = Templist& ，& MyCol（n）
下一个
 
 Templist = Mid（Templist，2）
 
范围（A2）。ClearContents：Range（A2）。 。删除
 
'创建数据验证列表
如果Len（Trim（Templist））<> 0然后
带有范围（A2）验证
 .Add类型：= xlValidateList，AlertStyle：= xlValidAlertStop，运算符：= xlBetween，Formula1：= Templist 
 .IgnoreBlank = True 
 .InCellDropdown = True 
 .InputTitle =
 .ErrorTitle =
 .InputMessage =
 .ErrorMessage =
 .ShowInput = True 
 .ShowError = True 
 End with 
 End If 
 
'捕获单元格A2中的更改
 ElseIf不相交（目标，范围（A2） ）$ Not $ Then 
 SearchString = Range（A2）。value 
 
 Templist = FindRange（Sheet2.Range（A2：A& LastRow），SearchString）
 
 Range（B2）。ClearContents：Range（B2）。Validation.Delete 
 
如果Len（Trim（Templist））& 0然后
'创建DV列表
带范围（B2）验证
 .Add类型：= xlValidateList，AlertStyle：= xlValidAlertStop，运算符：= 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 
退出子
哇：
 MsgBox Err.Description 
 Resume LetsContinue 
 End Sub 
 
'从Col B找到列表所需的功能
函数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 
 
设置aCell = FirstRange.Find（what：= StrSearch，LookIn：= xlValues，lookat：= xlWhole，SearchOrder：= _ 
 xlByRows ，SearchDirection：= xlNext，MatchCase：= False，SearchFormat：= False）
 
 ExitLoop = False 
 
如果不是aCell是没有，然后
设置bCell = aCell 
 strTemp = strTemp& ，& aCell.Offset（，1）.Value 
 Do While ExitLoop = False 
设置aCell = FirstRange.FindNext（After：= aCell）
 
如果不是aCell是没有，然后
如果aCell.Address = bCell.Address然后退出Do 
 strTemp = strTemp& ，& aCell.Offset（，1）.Value 
 Else 
 ExitLoop = True 
如果
循环
 FindRange = Mid（strTemp，2）
 End If 
结束功能
  

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

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

解决方案

我打算转到这个页面这非常好地描述了动态依赖列表的使用。
动态相关列表

也许你根本不需要VBA，除非你必须在飞行中更改这些，或者基于一些其他变量。最好先使用Excel的内置功能，然后编写第二个代码。

如果您正在游荡，您可以通过设置两个不同的列表来查看列表命名范围范围到整个工作簿。

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

既然你没有不能确定你的相交是否在这里：

 如果不相交（目标，Sheet2.Columns（1））是没有，然后
  

但我认为是。尝试这样：

 如果不相交（目标，列（1）.EntireColumn）没有，然后
  

I'm not really expert in VBA and I have a problem with my code and I don't know how to solve it. (The code is from: http://siddharthrout.wordpress.com/2011/07/29/excel-data-validationcreate-dynamic-dependent-lists-vba/)

I'm working with 8 dynamic dependent lists, and I thought the best way to automate the process and avoid to modify the macro in a future if I modify the lists was a VBA code.

Trying to find the correct code, I'm just working with to lists. For after, apply it for all lists.

I've checked the code and I discovered that there's an error (method 'intersect' of object '_global' failed) because I'm comparing two ranges from a different worksheets.

My code is:

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

Into the Sheet1, I just want the cells to select the list options and into the Sheet2, I want the all dynamic and dependent lists.

Is there any possibility to compare two ranges from a different worksheets using these algorithm? Or an alternative code to create a pick list for 8 depending and dynamic lists?

解决方案

I am going to turn you to this page that describes dynamic dependent list usage very well. Dynamic Dependent Lists

Perhaps you don't need VBA at all, unless you have to alter these on the fly, or based on some other variable. It's always best to use Excel's built-in functionality first, and code 2nd.

In case you are wandering, you can get around having lists on two different sheets by setting the named range scope to the entire workbook.

Edit: Adding answer to direct VBA error.

Since you didn't say, not sure if your Intersect is breaking here:

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

but I think it is. Try this:

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

这篇关于VBA中分离的工作表中的动态依赖列表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！