ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1174|回复: 6

[讨论] VBA 实现VloopUp函数功能

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-2-25 20:41 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助


背景:
在我实际工作中,在某个Excel 表格中大量使用到Vlookup 函数,相应的副作用也明显,那就造成该文件的计算需求极大的增加,遇到开启文档或者筛选,经常造成电脑卡顿,

解决方向:
参考论坛中的各位之前的代码,使用VBA+自定义菜单,实现Vlookup的功能

各位前辈也请多多指教,看看对代码是否有更好的优化空间


  1. Private Sub vbalookupPlus()
  2. Dim lookupRange As Range
  3. Dim refRange As Range
  4. Dim dataCol As Integer
  5. Dim Dict As Object
  6. Dim myRow As Range
  7. Dim lookRow As Range
  8. Dim destinationRow As Range
  9. On Error Resume Next
  10. Dim I As Double, J As Double
  11.   ' 1. Build a dictionnary
  12. Set Dict = CreateObject("Scripting.Dictionary")
  13. Set lookupRange = Application.InputBox("Pls select lookup range", Type:=8)
  14. If lookupRange Is Nothing Then
  15.     MsgBox prompt:="You not select any range", Title:="VBALookUp By Fred"
  16.     Exit Sub
  17. End If
  18. dataCol = Application.InputBox("CostList's Col", Type:=1)
  19. If dataCol < 2 Then
  20.     MsgBox prompt:="Lookup Col can't < 2", Title:="VBALookUp By Fred"
  21.     Exit Sub
  22. End If
  23. Set destinationRow = Application.InputBox("Paste Ragne", Type:=8)
  24. If destinationRow Is Nothing Or destinationRow.Cells.Count > 1 Then
  25.     MsgBox prompt:="Error" & Chr(10) & "1.Not Select Range" & Chr(10) & "2.Select Range >2", Title:="VBALookUp By Fred"
  26.     Exit Sub
  27. End If
  28. Set refRange = Range("CostList")
  29. Dim vResults As Variant

  30.   For Each myRow In refRange.Columns(1).Cells
  31.     '2 Append A : B to dictionnary
  32.         If Not Dict.Exists(myRow.Value) Then
  33.             Dict.Add myRow.Value, myRow.Offset(0, dataCol - 1).Value
  34.         End If
  35.   Next myRow
  36. ReDim vResults(1 To lookupRange.Rows.Count, 1 To 1)
  37. I = 1
  38. For Each lookRow In lookupRange
  39.   ' 3. Use it over all lookup data
  40.       If Dict.Exists(lookRow.Value) Then
  41.         vResults(I, 1) = Dict(lookRow.Value)
  42.       Else
  43.         vResults(I, 1) = ""
  44.       End If
  45.     I = I + 1
  46. Next lookRow
  47.   ' 3. Paste Data on Range
  48. destinationRow.Resize(UBound(vResults), 1) = vResults
  49. Set Dict = Nothing
  50. Set lookupRange = Nothing
  51. Set destinationRow = Nothing
  52. Erase vResults
  53. End Sub
复制代码


TA的精华主题

TA的得分主题

发表于 2020-2-25 22:42 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
用application.vlookup 行吗

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-26 08:11 来自手机 | 显示全部楼层
pattonzhai 发表于 2020-2-25 22:42
用application.vlookup 行吗

具体怎么实现呢,是否相应代码,望赐教

TA的精华主题

TA的得分主题

发表于 2020-2-26 08:38 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
几点意见:
1.输入lookuprange 等区域很不友好,且无法大规模运用。建议用参数返回值。
2.这个速度不可能超过函数vlookup的速度。可以加入timer进行测试。
但是该程序段可以作为学习着参考,提供了很好的思路和方法。尤其是初学字典的人,很有借鉴意义。

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-26 11:52 来自手机 | 显示全部楼层
素心1218 发表于 2020-2-26 08:38
几点意见:
1.输入lookuprange 等区域很不友好,且无法大规模运用。建议用参数返回值。
2.这个速度不可能 ...

感谢您的建议

1.输入lookuprange 等区域很不友好,且无法大规模运用。建议用参数返回值。
我实际应用中,是可以批量查询,InputBox 可以选择类似于A1:A5000的 Range 对象,参数返回值,我晚点试试,

2.这个速度不可能超过函数vlookup的速度。可以加入timer进行测试。
不用VLookup原因,是使用过多Vlookup,造成Excel运算缓慢,关闭自动重算,还是没能解决,

但是该程序段可以作为学习着参考,提供了很好的思路和方法。尤其是初学字典的人,很有借鉴意义。

TA的精华主题

TA的得分主题

发表于 2020-2-26 12:52 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
写的很详细,学习了。

不过查找过程全循环一遍,这样比vlookup慢吧,lookup系列函数应该算比较快的了,不知道你实际应用如何

TA的精华主题

TA的得分主题

发表于 2020-2-26 13:33 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
qwop99 发表于 2020-2-26 11:52
感谢您的建议

1.输入lookuprange 等区域很不友好,且无法大规模运用。建议用参数返回值。

我说的大规模查找不是针对一张表,比如有几张表,总表第一列是员工姓名,从第2列开始,每列对应一个项目,现在要在各分表中查找人员名字,并找到对应项目中的值(每个表的项目个数是不一样的),将该值放入总表对应的员工和项目下面。用vlookup和hlookup嵌套很容易实现,但是用你的代码就很难哦
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 04:06 , Processed in 0.042333 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表