Vlookup,在vba中一般用Application.Vlookup来实现,但总归要通过循环完成,如有不匹配的还报错,感觉效率不高。这里直接上几个用字典替代vlookup的方法。
方法一(经测试,3000行数据匹配,只需0.0156秒):
方法一(经测试,3000行数据匹配,只需0.0156秒):
Sub VLOOKUP_01()
Dim t As Date
t = Timer
Application.ScreenUpdating = False
Sheets("DD").Range("AE2:AF10000").Clear
Set ddcl = Sheets("数据源")
Set dd = Sheets("目标表")
Dim data, temp, arr, brr
Dim d, v
Dim i&, k&
Set d = CreateObject("scripting.dictionary")
Set v = CreateObject("scripting.dictionary")
data = ddcl.[a2].CurrentRegion '被索引的数据表,也可以用具体的区域
'data = ddcl.Range("A1:D65536")
For i = 2 To UBound(data)
d(data(i, 1) & "") = data(i, 3) '被取值所在列,如果只匹配一列,就不需v字典了
v(data(i, 1) & "") = data(i, 4) '被取值所在列
Next
ddm = dd.Range("A65536").End(xlUp).Row
temp = dd.Range("k1:k" & ddm) '索引参照列,注意必须是第一行开始
ReDim arr(2 To UBound(temp), 1 To 1)
ReDim brr(2 To UBound(temp), 1 To 1)
For k = 2 To UBound(temp)
arr(k, 1) = d(temp(k, 1))
brr(k, 1) = v(temp(k, 1))
Next
dd.[AE2].Resize(UBound(arr) - 1, 1) = arr
dd.[AF2].Resize(UBound(brr) - 1, 1) = brr
Set d = Nothing
MsgBox "运行" & Format((Timer - t), "0.0000") & "秒"
End Sub
注意:目标表中的索引参照范围,必须从表的第一行开始,或者用dd.[K1].CurrentRegion
Dim t As Date
t = Timer
Application.ScreenUpdating = False
Sheets("DD").Range("AE2:AF10000").Clear
Set ddcl = Sheets("数据源")
Set dd = Sheets("目标表")
Dim data, temp, arr, brr
Dim d, v
Dim i&, k&
Set d = CreateObject("scripting.dictionary")
Set v = CreateObject("scripting.dictionary")
data = ddcl.[a2].CurrentRegion '被索引的数据表,也可以用具体的区域
'data = ddcl.Range("A1:D65536")
For i = 2 To UBound(data)
d(data(i, 1) & "") = data(i, 3) '被取值所在列,如果只匹配一列,就不需v字典了
v(data(i, 1) & "") = data(i, 4) '被取值所在列
Next
ddm = dd.Range("A65536").End(xlUp).Row
temp = dd.Range("k1:k" & ddm) '索引参照列,注意必须是第一行开始
ReDim arr(2 To UBound(temp), 1 To 1)
ReDim brr(2 To UBound(temp), 1 To 1)
For k = 2 To UBound(temp)
arr(k, 1) = d(temp(k, 1))
brr(k, 1) = v(temp(k, 1))
Next
dd.[AE2].Resize(UBound(arr) - 1, 1) = arr
dd.[AF2].Resize(UBound(brr) - 1, 1) = brr
Set d = Nothing
MsgBox "运行" & Format((Timer - t), "0.0000") & "秒"
End Sub
EXCEL学习的超链分享
[
2019/12/09 10:01 | by 白燕湾 | Via 本站原创 ]

今年三月份,因为一个内部培训的需要,整理了这个Excel学习文档。该文档汇集了我10多年来学习、使用Excel的心得,如果您也是Excel学习者,可收藏。
1、网址:http://e.ttinn.com或http://e.cniapp.com;
2、首页(或刷新网址、或空值点“查询”按钮)只随机读取一篇文档;
3、点击右侧半透明的放大镜按钮,会弹出一个搜索框;
4、通过“关键字”可以进行模糊查询。
本文档至少包括99个常用函数及操作技能的使用说明,以下直接插入该网站供参考。
1、网址:http://e.ttinn.com或http://e.cniapp.com;
2、首页(或刷新网址、或空值点“查询”按钮)只随机读取一篇文档;
3、点击右侧半透明的放大镜按钮,会弹出一个搜索框;
4、通过“关键字”可以进行模糊查询。
本文档至少包括99个常用函数及操作技能的使用说明,以下直接插入该网站供参考。
在ACCESS中用VBA设置EXCEL单元格的格式
[
2016/09/25 09:29 | by 吕进 | Via 本站原创 ]

在ACCESS中用VBA更改EXCEL单格元格的格式可用以下代码:
Private Sub test5() 'EXCEL单元格格式设置
Dim excelapplication As Object
Dim str As String
str = Application.CurrentProject.Path & "\book1.xls"
Set excelapplication = GetObject(str) '获取指定的EXCEL文件
With excelapplication.sheets(1)
.Range(.Cells(1, 1), .Cells(3, 4)).Borders.LineStyle = xlContinuous '设置单元格的边框
.Range(.Cells(1, 1), .Cells(3, 4)).Borders.ColorIndex = xlAutomatic '设置单元格边框的颜色,可用1~56间的数字设置不同的颜色
.Range(.Cells(1, 1), .Cells(3, 4)).NumberFormat = "0.00%" '设置单元格的值以百分比的形式显示
.Range(.Cells(1, 1), .Cells(3, 4)).interior.ColorIndex = 24 '设置单元格的颜色
.Range(.Cells(1, 1), .Cells(3, 4)).Font.Bold = True '字体加粗
End With
End Sub
Dim excelapplication As Object
Dim str As String
str = Application.CurrentProject.Path & "\book1.xls"
Set excelapplication = GetObject(str) '获取指定的EXCEL文件
With excelapplication.sheets(1)
.Range(.Cells(1, 1), .Cells(3, 4)).Borders.LineStyle = xlContinuous '设置单元格的边框
.Range(.Cells(1, 1), .Cells(3, 4)).Borders.ColorIndex = xlAutomatic '设置单元格边框的颜色,可用1~56间的数字设置不同的颜色
.Range(.Cells(1, 1), .Cells(3, 4)).NumberFormat = "0.00%" '设置单元格的值以百分比的形式显示
.Range(.Cells(1, 1), .Cells(3, 4)).interior.ColorIndex = 24 '设置单元格的颜色
.Range(.Cells(1, 1), .Cells(3, 4)).Font.Bold = True '字体加粗
End With
End Sub
运行VBA时出现 &H80040111错误
[
2016/05/31 18:41 | by 白燕湾 | Via 本站原创 ]

在使用Excel VBA的时候,尤其是有设计的Form窗体并且上面有列表框等控件时,经常会碰到在某些电脑上打开出现“无法加载这个对象,因为它不适用于这台计算机”的问题。这个问题产生的主要原因是由于两台电脑上的MSCOMCTL.OCX版本不同。尤其是在高版本的Office里创建的窗体和控件,在低版本的Office或电脑上打开时就有可能出现这个问题。
或者出现:“&H80040111错误” 的提示,这些现象,基本都是因为版本不同导致的。
最终解决方案
1.取得MSCOMCTL.OCX最新版6.1.98.34(见附件)
2.到C:\WINDOWS\system32下找到文件MSCOMCTL.OCX
3.用新版本覆盖旧版本
4.点右键查看"属性"-"版本",看版本号是否更新为6.1.98.34
5.点"开始-运行" 输入:Regsvr32 MSCOMCTL.OCX
做到此步后,从新打开EXCEL,应该就可以了
win7 64位 的解决办法:
1、将MSCOMCTL.OCX最新版6.1.98.34 复制到C:\Windows\SysWOW64\目录下面
2、运行:cmd 第二步选择(以管理员身份运行)
3、在dos窗口中输入
cd c:\windows\syswow64 [回车键]
regsvr32 MSCOMCTL.OCX [回车键]
运行dos命令行(就是cmd)是一定要以管理员身份
下载文件 (已下载 6682 次)
或者出现:“&H80040111错误” 的提示,这些现象,基本都是因为版本不同导致的。
最终解决方案
1.取得MSCOMCTL.OCX最新版6.1.98.34(见附件)
2.到C:\WINDOWS\system32下找到文件MSCOMCTL.OCX
3.用新版本覆盖旧版本
4.点右键查看"属性"-"版本",看版本号是否更新为6.1.98.34
5.点"开始-运行" 输入:Regsvr32 MSCOMCTL.OCX
做到此步后,从新打开EXCEL,应该就可以了
win7 64位 的解决办法:
1、将MSCOMCTL.OCX最新版6.1.98.34 复制到C:\Windows\SysWOW64\目录下面
2、运行:cmd 第二步选择(以管理员身份运行)
3、在dos窗口中输入
cd c:\windows\syswow64 [回车键]
regsvr32 MSCOMCTL.OCX [回车键]
运行dos命令行(就是cmd)是一定要以管理员身份

一、初识字典
1、英文名字 Dictionary
2、存在于 Scrrun.dll 文件中
3、需将文件注册到系统中
4、需引用文件的声明方法
4.1、Dim D As Scripting.Dictionary (使用时还需用代码创建)
4.2、Dim D As New Scripting.Dictionary(对象实例化声明,声明后可直接使用)
4.3、声明时 Scripting 可省略
5、创建法
5.1、Set D=CreateObject("Scripting.Dictionary")
5.2、Scripting 为 scrrun 文件的工程名称
5.3、Dictionary 为 Scripting 工程中的一个类模块(功能模块)
1、英文名字 Dictionary
2、存在于 Scrrun.dll 文件中
3、需将文件注册到系统中
4、需引用文件的声明方法
4.1、Dim D As Scripting.Dictionary (使用时还需用代码创建)
4.2、Dim D As New Scripting.Dictionary(对象实例化声明,声明后可直接使用)
4.3、声明时 Scripting 可省略
5、创建法
5.1、Set D=CreateObject("Scripting.Dictionary")
5.2、Scripting 为 scrrun 文件的工程名称
5.3、Dictionary 为 Scripting 工程中的一个类模块(功能模块)