当前工作表引用另3个工作表的内容为有效性

hcy1185

当前工作表引用另3个工作表的内容为有效性,说明在工作表里
Book1.rar (141.51 KB, 下载次数: 10)

2012-8-29 14:55 上传

点击文件名下载附件

hcy1185

高手云集的论坛,就没有人回答?能不能实现啊?不能也请回答一声啊!谢谢

AVEL

三张表的内容挺多的，用数据有效性下拉框，找个数据很费时间的。

AVEL

1. Option Explicit
   
2. Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   
3.     ActiveCell.Value = Me.ListBox1.Value
   
4. End Sub
   
5. 
   
6. Private Sub Worksheet_SelectionChange(ByVal T As Range)
   
7.     If T.Count > 1 Then Exit Sub
   
8.     If T.Column = 2 Then
   
9.         Dim d As Object, i As Integer, arr As Variant
   
10.         Dim sh As Worksheet
    
11.         Set d = CreateObject("Scripting.Dictionary")
    
12.         For Each sh In Sheets
    
13.             If sh.Name <> ActiveSheet.Name Then
    
14.                 arr = sh.Range("b6:b" & sh.[b65536].End(3).Row).Value
    
15.                 For i = 1 To UBound(arr)
    
16.                     If Len(arr(i, 1)) Then d(arr(i, 1)) = ""
    
17.                 Next
    
18.             End If
    
19.         Next
    
20.         If d.Count > 0 Then
    
21.             With Me.ListBox1
    
22.                 .Width = 400
    
23.                 .Height = 400
    
24.                 .Top = T.Top
    
25.                 .Left = T(1, 2).Left
    
26.                 .List = Application.Transpose(d.keys)
    
27.                 .Visible = True
    
28.             End With
    
29.         End If
    
30.         Set d = Nothing
    
31.     Else
    
32.         Me.ListBox1.Visible = False
    
33.     End If
    
34. End Sub
    

复制代码

AVEL

EH(AVEL)-Book1 12-08-29 16-34.rar (162.56 KB, 下载次数: 15)

2012-8-29 16:34 上传

点击文件名下载附件

hcy1185

AVEL 发表于 2012-8-29 16:21

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean


感谢老师回复!谢谢

hcy1185

AVEL 发表于 2012-8-29 16:35

附件下载后解压不了

AVEL

可以用的 不用管提示。
直接运行附件中的EXCEL文件就好

hcy1185

AVEL 发表于 2012-8-29 17:01
可以用的 不用管提示。
直接运行附件中的EXCEL文件就好

不太好用,谢谢

AVEL

那你想要什么样的？ 呃 非要数据有效性？