| 楼主 罗刚君 |
将数据取唯一值并生成有效性的下拉列表,用字典是首选 而且根据数据有效性的选择对象生成查询结果,用FIND较快 此类需求虽然用公式也可以实现,但是公式的缺点是要用到辅助区域,且效率太差,运算慢 用VBA一键生成 效果如下:  源代码如下: Sub 生成材料名称() On Error Resume Next Dim Dic1, str As String Set Dic1 = CreateObject("scripting.dictionary") For Item = 2 To Cells(Rows.Count, 3).End(xlUp).Row Dic1.Item(Cells(Item, 3).Value) = Cells(Item, 3).Value Next With [k3].Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(Dic1.items, ",") End With End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target(1).Address = "$K$3" Then If Len(Target(1)) > 0 Then Application.ScreenUpdating = False Range("L3:L10000").Clear Dim cell As Range, firstAddress As String, arr(1 To 10000, 1 To 1), i As Integer, tim tim = Timer With Worksheets(1).Range("C:C") Set cell = .Find(Target, LookAt:=xlWhole, LookIn:=xlValues) If Not cell Is Nothing Then firstAddress = cell.Address Do i = i + 1 arr(i, 1) = cell.Offset(0, 1).Value Set cell = .FindNext(cell) Loop While cell.Address <> firstAddress End If End With With [l3].Resize(i, 1) .Value = arr .Borders.LineStyle = xlContinuous .HorizontalAlignment = xlCenter End With Application.ScreenUpdating = True MsgBox Format(Timer - tim, "0.00秒") End If End If End Sub  VBA查询.rar |
| 2楼 双脚着地 |
好用 好用 好好用 |
| 3楼 dawin2046 |
谢谢分享。 |
| 4楼 yexpin |
谢谢老大分享 |
| 5楼 蒸蒸日上 |
 太神奇了，仰视中！ |