Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1805|回复: 6

优化超级匹配公式范围

[复制链接]
发表于 2017-8-16 14:23 | 显示全部楼层 |阅读模式
本帖最后由 95352975 于 2017-8-16 14:25 编辑

求助大大,想把匹配范围扩大至C、D、E列,请问如何修改以下公式,谢谢


Public d As Object
Private Sub Class_Initialize()
Set d = CreateObject("scripting.dictionary")
Sheets("表2").Select        '对照表存在的位置
r = Range("a1:b" & Cells(Rows.Count, 1).End(3).Row)               '将对照表值写入数组r
For i = 1 To UBound(r)


d(r(i, 1)) = r(i, 2)
Next
End Sub
Private Sub Class_Terminate()
Set d = Nothing
End Sub

副本数据匹配超级工具.rar

23.1 KB, 下载次数: 4

发表于 2017-8-16 14:44 | 显示全部楼层
大哥,你没有数据,猜不出来大哥你想做什么
回复

使用道具 举报

 楼主| 发表于 2017-8-16 15:08 | 显示全部楼层
苏子龙 发表于 2017-8-16 14:44
大哥,你没有数据,猜不出来大哥你想做什么

现在的工具表是依据表一A列,把表二的A列相同B列的结果体现在在表一的B列,现在想把结果扩大至
把表二的A列相同C列的结果体现在在表一的C列
把表二的A列相同D列的结果体现在在表一的D列
把表二的A列相同E列的结果体现在在表一的E列
回复

使用道具 举报

发表于 2017-8-16 21:00 | 显示全部楼层
你这个原来的代码实在看不懂,为什么要加个类模块

行数少就直接用vlookup

行数多就用字典加数组
回复

使用道具 举报

发表于 2017-8-16 21:03 | 显示全部楼层
  1. Public Sub test()
  2.     Dim d, arr, brr, crr(), i, n
  3.     arr = Sheet1.Range("a1:a" & Range("a65536").End(3).Row)
  4.     brr = Sheet2.Range("a1:e" & Sheet2.Range("e65536").End(3).Row)
  5.     Set d = CreateObject("Scripting.Dictionary")
  6.     ReDim crr(1 To UBound(brr, 1), 1 To UBound(brr, 2) - 1)
  7.     For i = 1 To UBound(brr, 1)
  8.         d(brr(i, 1)) = Array(brr(i, 2), brr(i, 3), brr(i, 4), brr(i, 5))
  9.     Next
  10.     For n = 1 To UBound(arr, 1)
  11.         If d.exists(arr(n, 1)) Then
  12.             crr(n, 1) = d(arr(n, 1))(0)
  13.             crr(n, 2) = d(arr(n, 1))(1)
  14.             crr(n, 3) = d(arr(n, 1))(2)
  15.             crr(n, 4) = d(arr(n, 1))(3)
  16.         End If
  17.     Next
  18.     Sheet1.Range("b1").Resize(UBound(crr, 1), UBound(crr, 2)) = crr
  19.     Set d = Nothing
  20.             
  21. End Sub
复制代码


代码
回复

使用道具 举报

 楼主| 发表于 2017-8-21 10:23 | 显示全部楼层

    brr = Sheet2.Range("a1:e" & Sheet2.Range("e65536").End(3).Row)
提示这条报错。。
回复

使用道具 举报

发表于 2017-8-21 18:10 | 显示全部楼层
95352975 发表于 2017-8-21 10:23
brr = Sheet2.Range("a1:e" & Sheet2.Range("e65536").End(3).Row)
提示这条报错。。

上传报错的附件


多半是工作表名称的问题

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 14:47 , Processed in 0.400362 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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