查看: 2284|回复: 14
多级联动下拉列表能否在最后一级上实现多选
阅读权限10
在线时间 小时
是希望首先有多级联动下拉的效果，类似于我在一级选择“中国”，第二级下拉列表里面就只有中国的省份，然后再二级选择了“广东”，出现在第三级的就只有广东省内的地市。现在是用 数据有效性 实现了三级联动。但是想实现在最后一级上的多选，就是说我最后一级可以同时选中几个地市，然后一起填入单元格。
不知道应该使用那类函数实现呢？看了listbox，但是表单内容好像都是固定的 啊，可以实现联动么？
(27.14 KB, 下载次数: 39)
16:23 上传
多级就是这样的效果
阅读权限100
在线时间 小时
欢迎新会员！
建议上传表格附件来说明问题。可以有控件来实现。
阅读权限10
在线时间 小时
蓝桥玄霜 发表于
欢迎新会员！
建议上传表格附件来说明问题。可以有控件来实现。
(12.63 KB, 下载次数: 71)
11:24 上传
点击文件名下载附件
现在就是实现了三级联动下拉，但是希望在第三级（也就是需求细分2）那里实现能够多选填入，可以么？可以的话，需要学习什么？
诚心求教！多谢啦~
阅读权限30
在线时间 小时
用listbox控件吧，将其属性设置成多选，并为其事件添加一些代码
阅读权限10
在线时间 小时
dqhtju 发表于
用listbox控件吧，将其属性设置成多选，并为其事件添加一些代码
listbox可以实现动态么？因为多选的内容是由前两级下拉的选择决定的。谢谢啦
阅读权限100
在线时间 小时
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count & 1 Then Exit Sub
If Target.Column & 7 Or Target.Column & 6 Or Target.Row & 3 Then Exit Sub
If Target = && Then Exit Sub
Dim d2, c%, i&
Set d2 = CreateObject(&Scripting.Dictionary&)
Call yy
If Target.Column = 6 Then
& & c = d(Target.Value)
& & For i = 2 To UBound(Arr)
& && &&&If Arr(i, c) = && Then Exit For
& && &&&d2(Arr(i, c)) = &&
& & Next
& & With Target.Offset(0, 1).Validation
& && &&&.Delete
& && &&&.Add 3, 1, 1, Join(d2.keys, &,&)
& & End With
& & Target.Offset(0, 1).Resize(1, 2) = &&
Else
& & c = d(Target.Value): d2.RemoveAll
& & For i = 2 To UBound(Arr)
& && &&&If Arr(i, c) = && Then Exit For
& && &&&d2(Arr(i, c)) = &&
& & Next
& & With Me.ListBox1
& && &&&.Visible = True
& && &&&.List = d2.keys
& && &&&.Top = Target.Offset(1, 0).Top
& && &&&.Left = Target.Offset(0, 1).Left
& & End With
& & Target.Offset(0, 1) = &&
End If
End Sub
复制代码
阅读权限100
在线时间 小时
& & & & & & & &
请见附件。
列表框双击时赋值给单元格。
14:53 上传
点击文件名下载附件
29.96 KB, 下载次数: 246
阅读权限10
在线时间 小时
蓝桥玄霜 发表于
请见附件。
列表框双击时赋值给单元格。
哇塞！好神奇！拜读代码先。。。看不懂可以继续求教么？
阅读权限70
在线时间 小时
蓝桥玄霜 发表于
请见附件。
列表框双击时赋值给单元格。
向蓝版学习一下。
有过类似情况：如果第二级也要多选呢？（第二级多选后，第三级的数据也对应包括所选的全部子项）
即第二、第三级都能实现多选，请教一下代码该如何修改
通用延申：多级联动（不一定为三级），所有级别都能实现多选功能。期待……
阅读权限10
在线时间 小时
蓝桥玄霜 发表于
请见附件。
列表框双击时赋值给单元格。
蓝老师您好~多谢解答！我想进一步问一下，之前是一个book里面两个sheet之间的关联，现在想做一个book里面有多个这样的两两对应sheet，是可以实现的么？大概看懂了您的代码是什么意思 但是不知道多个表格的话 有需要什么特殊处理设置的么？我尝试简单修改代码移植到另一个sheet，果然失败了。。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 7682|回复: 8
如何让一段代码快速的变成注释???
阅读权限20
在线时间 小时
& && &&&Cells.Select
& && &&&Selection.Borders(xlDiagonalDown).LineStyle = xlNone
& && &&&Selection.Borders(xlDiagonalUp).LineStyle = xlNone
& && &&&With Selection.Borders(xlEdgeLeft)
& && && && &.LineStyle = xlContinuous
& && && && &.Weight = xlThin
& && && && &.ColorIndex = xlAutomatic
& && &&&End With
& && &&&With Selection.Borders(xlEdgeTop)
& && && && &.LineStyle = xlContinuous
& && && && &.Weight = xlThin
& && && && &.ColorIndex = xlAutomatic
& && &&&End With
& && &&&With Selection.Borders(xlEdgeBottom)
& && && && &.LineStyle = xlContinuous
& && && && &.Weight = xlThin
& && && && &.ColorIndex = xlAutomatic
& && &&&End With
& && &&&With Selection.Borders(xlEdgeRight)
& && && && &.LineStyle = xlContinuous
& && && && &.Weight = xlThin
& && && && &.ColorIndex = xlAutomatic
& && &&&End With
& && &&&With Selection.Borders(xlInsideVertical)
& && && && &.LineStyle = xlContinuous
& && && && &.Weight = xlThin
& && && && &.ColorIndex = xlAutomatic
& && &&&End With
& && &&&With Selection.Borders(xlInsideHorizontal)
& && && && &.LineStyle = xlContinuous
& && && && &.Weight = xlThin
& && && && &.ColorIndex = xlAutomatic
& && &&&End With
我想先不用这一段代码,先把他们注释起来
难道一行一行的加单引号?
阅读权限90
在线时间 小时
VBE快捷菜单中就有一个设置注释块的图标
阅读权限100
在线时间 小时
(113.26 KB, 下载次数: 61)
08:47 上传
阅读权限90
在线时间 小时
宏菜单栏中有设置注释块与取消注释块的按钮哦
阅读权限95
在线时间 小时
“视图”-“工具栏”-勾选“编辑”。可以通过选中两行或多行代码并在“编辑”工具栏上通过选择“注释块”或“删除注释块”按钮来对该代码块添加或删除注释符号。
阅读权限20
在线时间 小时
回复 3楼 taller 的帖子
版主牛X&&很准确 很形象
& & PS:看了版主的视频讲解才知道这个论坛了,终于找到组织了[em07]
阅读权限20
在线时间 小时
好，支持！一直想实现这个功能，可是在GOOGLE里搜索都没有，因为我没有运用正确的关键词，哈哈
阅读权限70
在线时间 小时
看不见得，是不是就真的不存在
其实很多功能，仔细找找总会有的
阅读权限20
在线时间 小时
哈哈 这个方法很好用呢 ！ 终于找到解决的办法啦
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 5559|回复: 19
以EXCLE的某一列为源,如何向VBA界面里的COMBOBOX中添加不重复记录
阅读权限20
在线时间 小时
将EXCLE表中的某一列做为数据源,这其中包含重复数据.我想在VBA界面中的COMBOBOX中把这一列中不重复的值添到它的下拉列表框中.
简单点说就是在COMBOBOX中填充不重复记录.不知道该怎么实现.请各位帮忙,谢谢!
阅读权限50
在线时间 小时
把数据源添加到一个集合中，或用SQL取不重复值，再添到它的下拉列表框中
阅读权限20
在线时间 小时
我把COMBOBOX的ROWSOURCE设成了A:A,能具体说一下在VBA里怎么用SQL吗?
阅读权限95
在线时间 小时
另一思路：
Private Sub UserForm_Initialize()For i = 2 To Sheets("sheet2").[a65536].End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("sheet2").Range("a1:a" & i - 1), Sheets("sheet2").Range("a" & i)) = 0 Then
ComboBox1.AddItem Sheets("sheet2").Range("a" & i)
End IfNext iEnd Sub
阅读权限50
在线时间 小时
又学了一招新方法,谢谢oobird
阅读权限95
在线时间 小时
& & & & & & & &
嗯，学习 oobird 。
另外：烟雨厦江南 可否把 把数据源添加到一个集合中，或用SQL取不重复值，再添到它的下拉列表框中 的代码弄一个啊。偶开始想消化这方面的东东。
阅读权限50
在线时间 小时
PLXMM,这两种方法在UNARTHUR的精华贴子:VBA筛选非重复值方法比较
中有详细的例子,你可以先参考一下.
阅读权限50
在线时间 小时
先整理了一个SQL取不重复值的方法,假设取sheet1的A列数据:
sub additem()Dim cnn As New ADODB.ConnectionDim rst As New ADODB.RecordsetDim dbpath As String, strsql As StringDim icount As Integerdbpath = "provider=microsoft.jet.oledb.4.0;extended properties='Excel 8.0;HDR=yes';data source=" & ThisWorkbook.FullNamecnn.Open dbpathstrsql = "select distinct 列字段名 from [sheet1$A:A]"rst.Open strsql, cnn, adOpenKeyset, adLockPessimisticrst.MoveLasticount = rst.RecordCountrst.MoveFirstFor i = 1 To icountComboBox1.AddItem rst.Fields("列字段名")rst.MoveNextNext iSet rst = Nothingcnn.closeend sub
阅读权限95
在线时间 小时
document.body.clientWidth*0.5) {this.resized=this.width=document.body.clientWidth*0.5;this.style.cursor='pointer';} else {this.onclick=null}" alt="" />
(30.29 KB, 下载次数: 4)
16:05 上传
以EXCLE的某一列为源,如何向VBA界面里的COMBOBOX中添加不重复记录
阅读权限50
在线时间 小时
传个附件上来,PLXMM再测试一下.
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师Excel单元格中怎么才能设置一个下拉菜单提供多选功能
阅读权限10
在线时间 小时
& & & & & & & &
蓝桥玄霜 发表于
ThisWorkbook中的代码只是为了给组合框设置一个示例。
可以放到sheet1里面的。
版主，我一点都不懂的VBA，我花了一天的时间尝试着学习理解vba，但真心的是一头雾水，我现在遇到同样的问题，需要在一个单元格设置下拉菜单可以单选或是多选，求助，求赐教！
阅读权限100
在线时间 小时
艾米麗兒 发表于
版主，我一点都不懂的VBA，我花了一天的时间尝试着学习理解vba，但真心的是一头雾水，我现在遇到同样的问 ...
建议上传表格附件来说明问题。
阅读权限10
在线时间 小时
谢谢版主提醒，见附件，需要将事故类型1的词条在事故类型1的一列单元格设置每个单元格可以有下拉菜单，并可以单选或是多选，拜托版主！
16:38 上传
点击文件名下载附件
6.59 KB, 下载次数: 194
阅读权限10
在线时间 小时
蓝桥玄霜 发表于
建议上传表格附件来说明问题。
谢谢版主提醒，见附件，需要将事故类型1的词条在事故类型1的一列单元格设置每个单元格可以有下拉菜单，并可以单选或是多选，拜托版主！
阅读权限10
在线时间 小时
蓝桥玄霜 发表于
建议上传表格附件来说明问题。
版主，有我的问题能解么？
阅读权限100
在线时间 小时
& & & & & & & &
Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i&, aa$
If KeyCode = 13 Then
For i = 0 To ListBox1.ListCount - 1
& & If ListBox1.Selected(i) = True Then
& && &&&aa = aa & ListBox1.List(i) & & &
& & End If
Next
& && &&&ActiveCell.Value = aa
& && &&&ListBox1.Visible = False
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Myr&, Arr
If Target.Count & 1 Then Me.ListBox1.Visible = False: Exit Sub
If Target.Column && 9 And Target.Column && 10 Then Me.ListBox1.Visible = False: Exit Sub
If Target.Column = 9 Then
& & Myr = Cells(Rows.Count, &XFB&).End(xlUp).Row
& & Arr = Range(&xfb2:xfb& & Myr)
Else
& & Myr = Cells(Rows.Count, &XFc&).End(xlUp).Row
& & Arr = Range(&xfc2:xfc& & Myr)
End If
With Me.ListBox1
& & .Clear
& & .List = Application.Index(Arr, 0, 1)
& & .Left = Target.Left + Target.Width
& & .Top = ActiveCell.Top
& & .Width = ActiveCell.Width * 1.4
& & .Height = ActiveCell.Height * 8
& & .Visible = True
End With
End Sub
复制代码
阅读权限100
在线时间 小时
可以单选也可以多选。回车赋值给单元格。
请见附件。
11:55 上传
点击文件名下载附件
19.65 KB, 下载次数: 705
阅读权限50
在线时间 小时
用窗体不是很好吗
(19.86 KB, 下载次数: 536)
14:57 上传
点击文件名下载附件
阅读权限10
在线时间 小时
hzruziniu 发表于
用窗体不是很好吗
您好，我这边先做一个简单的下拉复选窗口，我下载了您的附件，但是不懂VBA还是做不成，希望您可以帮我看下，怎么做，如果可以麻烦加一下QQ：，万分感谢！
阅读权限20
在线时间 小时
长见识了啊
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 3565|回复: 10
判断某一列是否有重复（2W多行）
阅读权限20
在线时间 小时
& & & & & & & &
我要判断某一列是否有重复，如果重复，是在哪列重复，然后能挑出个MSGBOX。
我试了直接用个复制列，用公式判断每一行是否重复，然后再根据辅助列查找出哪里重复，再用MSGBOX。。但2W多行，我用了公式之后，就已经很卡了，寻求大大帮帮忙呀
阅读权限100
在线时间 小时
& & & & & & & &
用字典写就行& && &&&
阅读权限95
在线时间 小时
自己编的代码没有EXCEL自带的函数效率高，你用了辅助列后筛选一下大于1的不就可以了吗？
函数能有多快，VBA就有多快；VBA可以快的，函数未必可以快。&
误导大师！&
阅读权限20
在线时间 小时
问题是。我用了辅助列之后。就已经很卡了。。有什么办法。不用那么多辅助列行吗？
阅读权限30
在线时间 小时
用countif函数。
阅读权限100
在线时间 小时
给个附件吧，
阅读权限95
在线时间 小时
用数组，很快。
阅读权限95
在线时间 小时
还是rox 发表于
问题是。我用了辅助列之后。就已经很卡了。。有什么办法。不用那么多辅助列行吗？
如果重复数据不多的话，可以不用加辅助列，用数组公式：
统计出现最多次数：=MAX(COUNTIF(A1:A13,A1:A13))复制代码统计出现最多所在行：=LARGE((COUNTIF(A1:A13,A1:A13)=MAX(COUNTIF(A1:A13,A1:A13)))*ROW(A1:A13),1)复制代码
阅读权限95
在线时间 小时
本帖最后由 yaozong 于
13:21 编辑
Private Sub CommandButton1_Click()
Dim d, arr, i, j, k, t, v, w
'arr = [a1].CurrentRegion
arr=range(&a1&,[a65536].end(3))& &'假定数据在A列
Set d = CreateObject(&scripting.dictionary&)
For i = 1 To UBound(arr)
& & d(arr(i, 1)) = d(arr(i, 1)) + 1
k = d.keys: t = d.items: v = d.Count
Set d = Nothing
For j = 0 To v - 1
& & If t(j) & 1 Then
& && & If w = && Then w = k(j) & &/& & t(j) Else w = w & &;& & k(j) & &/& & t(j)
& & End If
MsgBox &重复值/重复次： & & Chr(10) & w
阅读权限30
在线时间 小时
9楼正解，收藏学习
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师