[已解决]帮忙修改代码（vba替代vlookup公式的）

hlb117

帮忙修改代码（vba替代vlookup公式的） 0315 mb.zip (129.29 KB, 下载次数: 41)

2014-3-14 21:13 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

那么的帅

2014-3-15 00:30

hlb117 发表于 2014-3-15 00:25
外部数据导入---文本型，，类型不匹配

1 方法1  选中 导入的数据，点击左上角的 叹号，选择 转换为数字 把文本转换为数值
2 方法2 修改代码

1. Sub aa()
   
2.     Dim d
   
3.     Dim arr, arr1, arr2
   
4.     Dim i As Long
   
5.     Range("G4:G" & [G65536].End(xlUp).Row).ClearContents
   
6.     arr1 = Range("F4:F" & [F65536].End(xlUp).Row)
   
7.     ReDim arr2(1 To UBound(arr1), 1 To 1)
   
8.     With Sheets("数据表")
   
9.         arr = .Range("b2:c" & .[b65536].End(xlUp).Row)
   
10.     End With
    
11.     Set d = CreateObject("Scripting.Dictionary")
    
12.     For i = 1 To UBound(arr)
    
13.         d(arr(i, 1)) = arr(i, 2)
    
14.     Next i
    
15.     For i = 1 To UBound(arr1)
    
16.         arr2(i, 1) = d(Val(arr1(i, 1)))
    
17.     Next i
    
18.     Range("G4").Resize(UBound(arr2), 1) = arr2
    
19. End Sub

复制代码

跳转到最佳答案楼层

那么的帅

320913-VBA-字典-根据条件返回数据.zip (129.66 KB, 下载次数: 39)

2014-3-14 21:26 上传

点击文件名下载附件

810126769

0315 mb.rar (82.11 KB, 下载次数: 14)

2014-3-14 21:31 上传

点击文件名下载附件

改这一句就行了：
Dim d As Object
    Dim arr, arr1, arr2
    Dim i As Long
    Set d = CreateObject("scripting.dictionary")

1. 
   
2. 
   
3. Sub aa()
   
4.     Dim d As Object
   
5.     Dim arr, arr1, arr2
   
6.     Dim i As Long
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     Range("G4:G" & [G65536].End(xlUp).Row).ClearContents
   
9.     arr1 = Range("F4:F" & [F65536].End(xlUp).Row)
   
10.     ReDim arr2(1 To UBound(arr1), 1 To 2)
    
11.     With Sheets("数据表")
    
12.         arr = .Range("b2:c" & .[b65536].End(xlUp).Row)
    
13.     End With
    
14.     For i = 1 To UBound(arr)
    
15.        d(arr(i, 1)) = Array(arr(i, 2))
    
16.     Next i
    
17.     For i = 1 To UBound(arr1)
    
18.         arr2(i, 1) = d(arr1(i, 1))(0)
    
19.         
    
20.     Next i
    
21.     Range("G4").Resize(UBound(arr2), 2) = arr2
    
22. End Sub
    
23. 
    
24. 
    

复制代码

hlb117

810126769 发表于 2014-3-14 21:30
改这一句就行了：
Dim d As Object
    Dim arr, arr1, arr2

v1320913-VBA-字典-根据条件返回数据.zip (129.7 KB, 下载次数: 6)

2014-3-15 00:23 上传

点击文件名下载附件 外部导入的数据-文本型，类型不匹配

hlb117

那么的帅 发表于 2014-3-14 21:26

v1320913-VBA-字典-根据条件返回数据.zip (129.7 KB, 下载次数: 8)

2014-3-15 00:25 上传

点击文件名下载附件 外部数据导入---文本型，，类型不匹配

那么的帅

hlb117 发表于 2014-3-15 00:25
外部数据导入---文本型，，类型不匹配

1 方法1  选中 导入的数据，点击左上角的 叹号，选择 转换为数字 把文本转换为数值
2 方法2 修改代码

1. Sub aa()
   
2.     Dim d
   
3.     Dim arr, arr1, arr2
   
4.     Dim i As Long
   
5.     Range("G4:G" & [G65536].End(xlUp).Row).ClearContents
   
6.     arr1 = Range("F4:F" & [F65536].End(xlUp).Row)
   
7.     ReDim arr2(1 To UBound(arr1), 1 To 1)
   
8.     With Sheets("数据表")
   
9.         arr = .Range("b2:c" & .[b65536].End(xlUp).Row)
   
10.     End With
    
11.     Set d = CreateObject("Scripting.Dictionary")
    
12.     For i = 1 To UBound(arr)
    
13.         d(arr(i, 1)) = arr(i, 2)
    
14.     Next i
    
15.     For i = 1 To UBound(arr1)
    
16.         arr2(i, 1) = d(Val(arr1(i, 1)))
    
17.     Next i
    
18.     Range("G4").Resize(UBound(arr2), 1) = arr2
    
19. End Sub

复制代码

hlb117

那么的帅 发表于 2014-3-15 00:30
1 方法1  选中 导入的数据，点击左上角的 叹号，选择 转换为数字 把文本转换为数值
2 方法2 修改代码

老师帮忙看看代码，哪不对了，详见附件 201308.zip (391.32 KB, 下载次数: 3)

2014-3-17 13:59 上传

点击文件名下载附件

hlb117

hlb117 发表于 2014-3-17 13:59
老师帮忙看看代码，哪不对了，详见附件

老师帮忙看看代码，哪不对了，详见附件 201308.zip (391.32 KB, 下载次数: 2)

2014-3-17 16:55 上传

点击文件名下载附件

hlb117

那么的帅 发表于 2014-3-15 00:30
1 方法1  选中 导入的数据，点击左上角的 叹号，选择 转换为数字 把文本转换为数值
2 方法2 修改代码

201308.zip (391.32 KB, 下载次数: 8)

2014-3-17 19:11 上传

点击文件名下载附件 请老师帮忙看看代码，哪儿不对了，详见附件

那么的帅

hlb117 发表于 2014-3-17 19:11
请老师帮忙看看代码，哪儿不对了，详见附件

问题解决，请设置最佳答案，
如果有新问题，重新发帖提问