数据查找问题

z865593849

简单的字典

2024-12-14 test.zip (869.3 KB, 下载次数: 8)

2024-12-15 08:53 上传

点击文件名下载附件

wwdfefgg

z865593849 发表于 2024-12-15 08:53
简单的字典

运行不了啊，，点按钮没反应


111.rar (790.79 KB, 下载次数: 0)

2024-12-15 09:15 上传

点击文件名下载附件

wwdfefgg

z865593849 发表于 2024-12-15 08:53
简单的字典

另外不要在最前面加空行，格式不能变，后续还有其他操作呢

wwdfefgg

求高手解决。。。。。。。。。。。。。。。。

wwdfefgg

顶起来。。。。。。。。。。。。。。。。

wwdfefgg

顶起来。。。。。。。。。。。。沉的好快

ykcbf1100

wwdfefgg 发表于 2024-12-15 08:02
抄过了，，运行不了，提示下标越界。。。。

再核对一下,是不是哪里抄错了.

wwdfefgg

ykcbf1100 发表于 2024-12-15 16:32
再核对一下,是不是哪里抄错了.

1. Sub 查找h列()
   
2. Dim arr, brr
   
3. Dim dic
   
4. Set dic = CreateObject("scripting.dictionary")
   
5. arr = Sheets(1).[al].Resize(10000, 9)
   
6. For x = 2 To UBound(arr)
   
7. If Len(arr(x, l)) Then
   
8. dic("'" & arr(x, 1)) = x
   
9. End If
   
10. Next
    
11. 
    
12. 
    
13. Sheets(2).[b3].Resize(10000, 1).ClearContents
    
14. brr = Sheets(2).[a2].CurrentRegion
    
15. For i = 2 To UBound(brr)
    
16. 
    
17. If dic.exists("'" & brr(i, 1)) Then
    
18. brr(i, 2) = arr(dic("'" & brr(i, 1)), 8)
    
19. Else
    
20. k = k + 1
    
21. End If
    
22. 
    
23. 
    
24. Next
    
25. 
    
26. 
    
27. Sheets(2).[a3].CurrentRegion = brr
    
28. 
    
29. MsgBox "还有" & k & "个未找到!"
    
30. 
    
31. End Sub
    

复制代码

代码核对过了，，没抄错啊，，老提示下标越界

chxw68

参与一下。

wwdfefgg

chxw68 发表于 2024-12-15 17:29
参与一下。

谢谢版主