数据字典代替vlookup问题

vleexhya

首先感谢各位老师的帮助！

本人因为vlookup不够用才知道数据字典的，但有一个困惑，包括蓝版的  “常见字典用法集锦及代码详解(全)_蓝桥玄霜”  都未见加入，那就是替代vlookup的基本功能实例，如下：

在EXCEL公式里这样操作：
vlookup（要查找的关键字，数据源，指定想要的结果在字典中的列，精确查找）

有没有比较简单的替代vlookup的EXCEL宏代码：
对数据源建立字典，key 对应  item1,item2,item3，item4
然后通过key查找，和vlookup一样，通过肉眼识别需要的结果在哪一列，就查字典看看字典里该结果在第几个item里？

不知道我的表述清不清楚。
也就是：B列的结果我指定在数据源里的I列查找，C列的结果我指定在数据源里的K列查找，G列的结果我指定在数据源里的L列查找，不管数据源的字段（首行）是什么内容。
具体见附件。

无关岁月

11.7z (14.85 KB, 下载次数: 9)

2024-1-31 16:25 上传

点击文件名下载附件

feilanga

列明需求，直接给你代码。

vleexhya

无关岁月 发表于 2024-1-31 16:26

多谢帮助，我要仔细看看，平时挺常用的。老师这个代码好像也需要字段匹配。我的意思，字段item1在数据源里是在第2列，不管数据源里的字段如何更改，就查第2列的结果。

vleexhya

feilanga 发表于 2024-1-31 16:27
列明需求，直接给你代码。

我的意思，需要显示结果的表里，字段item1在数据源里是在第2列，不管数据源里的字段“item1”如何更改，就查第2列的结果。

ykcbf1100

B列的结果我指定在数据源里的I列查找，C列的结果我指定在数据源里的K列查找，G列的结果我指定在数据源里的L列查找，不管数据源的字段（首行）是什么内容。
那我问问你，C列的结果你怎么知道要在K列找呢？你源数据标题至少要从小到大排序过的，这样才能象vlookup函数那样，在第几列查找。

无关岁月

不是很明白，再猜
副本11.7z (14.78 KB, 下载次数: 5)

2024-1-31 20:22 上传

点击文件名下载附件

vleexhya

ykcbf1100 发表于 2024-1-31 20:17
B列的结果我指定在数据源里的I列查找，C列的结果我指定在数据源里的K列查找，G列的结果我指定在数据源里的L ...

比如  I列是成绩  肉眼识别的,  B列就是查成绩的结果， 如果I列的字段名（首行）不是”成绩“而是”性别“，但I列下面的内容（除首行）实际是成绩，那就从I列查。这样的目的是我这种菜鸟折中的办法，如果不肉眼识别需要查找的内容在哪一列，估计代码复杂一点，不便于我在日常中举一反三的应用。  
我确实忽略了vlookup还要排序。

ykcbf1100

vleexhya 发表于 2024-2-1 08:17
比如  I列是成绩  肉眼识别的,  B列就是查成绩的结果， 如果I列的字段名（首行）不是”成绩“而是”性别 ...

是这意思吗？查询和字段名无关，只与数据顺序号有关。

ykcbf1100

代码如下，供参考。。。

1. Sub ykcbf()  '//2024.2.1
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = Me.Cells(Rows.Count, "h").End(3).Row
   
4.     arr = Me.Range("h1:m" & r)
   
5.     For i = 2 To UBound(arr)
   
6.         For j = 2 To UBound(arr, 2)
   
7.             s = arr(i, 1) & "|" & j
   
8.             d(s) = arr(i, j)
   
9.         Next
   
10.     Next
    
11.     r = Me.Cells(Rows.Count, "a").End(3).Row
    
12.     arr = Me.Range("a1:d" & r)
    
13.     For i = 2 To UBound(arr)
    
14.         For j = 2 To UBound(arr, 2)
    
15.             s = arr(i, 1) & "|" & j
    
16.             arr(i, j) = d(s)
    
17.         Next
    
18.     Next
    
19.     Me.Range("a1:d" & r) = arr
    
20.     MsgBox "OK！"
    
21. End Sub
    

复制代码