[已解决]VBA实现查表 返回五行属性

laoau138

VBA实现查表 返回五行属性

最佳答案

月排行榜 / 总排行榜

lmze2000

2017-2-28 13:27

1. Sub Tj()
   
2.     Dim Rng As Range, Arr
   
3.     Set Rng = [d1:e5]
   
4.     Arr = [a1].CurrentRegion
   
5.     For i = 1 To UBound(Arr)
   
6.         Cells(i, 2) = Cells(Rng.Find(Arr(i, 1), , , xlWhole).Row, "F")
   
7.     Next
   
8.     MsgBox "查表完成"
   
9.    
   
10. End Sub
    
11. 
    
12. Sub TJ2()
    
13.     Dim Arr, Brr
    
14.     Brr = [d1:f5]
    
15.     Arr = [a1].CurrentRegion
    
16.     For i = 1 To UBound(Arr)
    
17.         For j = 1 To UBound(Brr)
    
18.             If Arr(i, 1) = Brr(j, 1) Or Arr(i, 1) = Brr(j, 2) Then
    
19.                 Cells(i, 2) = Brr(j, 3)
    
20.             End If
    
21.         Next
    
22.     Next
    
23.     MsgBox "查表完成"
    
24. End Sub
    

复制代码

数组和find两种方法实现，你看一下，你这天天都是弄啥东西啊。

跳转到最佳答案楼层

望帝春心

到底用函数还是用VBA？

xiangbaoan

Sub IfuleU()
Dim d, arr, brr, r&, c%
[b1:b888] = ""
Set d = CreateObject("scripting.dictionary")
arr = Range("a1:b" & Cells(Rows.Count, 1).End(xlUp).Row)
brr = [d1].CurrentRegion
For c = 1 To 2
    For r = 1 To UBound(brr)
        d(brr(r, c)) = brr(r, 3)
    Next
Next
For r = 1 To UBound(arr)
    arr(r, 2) = d(arr(r, 1))
Next
[a1].Resize(UBound(arr), 2) = arr
Set d = Nothing
End Sub

laoau138

望帝春心 发表于 2017-2-28 12:08
到底用函数还是用VBA？

现在需要用VBA
函数已经有人做了

laoau138

xiangbaoan 发表于 2017-2-28 12:41
Sub IfuleU()
Dim d, arr, brr, r&, c%
= ""

请用数组方法做

望帝春心

laoau138 发表于 2017-2-28 12:46
现在需要用VBA
函数已经有人做了

你是要别人给你用VBA写一个LOOKUP和VLOOKUP吗？老师你太暴力了...

laoau138

望帝春心 发表于 2017-2-28 12:47
你是要别人给你用VBA写一个LOOKUP和VLOOKUP吗？老师你太暴力了...

用VBA可以      可以不用lookup和VLOOKUP

lmze2000

1. Sub Tj()
   
2.     Dim Rng As Range, Arr
   
3.     Set Rng = [d1:e5]
   
4.     Arr = [a1].CurrentRegion
   
5.     For i = 1 To UBound(Arr)
   
6.         Cells(i, 2) = Cells(Rng.Find(Arr(i, 1), , , xlWhole).Row, "F")
   
7.     Next
   
8.     MsgBox "查表完成"
   
9.    
   
10. End Sub
    
11. 
    
12. Sub TJ2()
    
13.     Dim Arr, Brr
    
14.     Brr = [d1:f5]
    
15.     Arr = [a1].CurrentRegion
    
16.     For i = 1 To UBound(Arr)
    
17.         For j = 1 To UBound(Brr)
    
18.             If Arr(i, 1) = Brr(j, 1) Or Arr(i, 1) = Brr(j, 2) Then
    
19.                 Cells(i, 2) = Brr(j, 3)
    
20.             End If
    
21.         Next
    
22.     Next
    
23.     MsgBox "查表完成"
    
24. End Sub
    

复制代码

数组和find两种方法实现，你看一下，你这天天都是弄啥东西啊。

laoau138

lmze2000 发表于 2017-2-28 13:27
数组和find两种方法实现，你看一下，你这天天都是弄啥东西啊。

实在太菜了，你不要见怪

VBA计算多列最大连续  用数组方法不要用字典

http://www.excelpx.com/thread-428091-1-1.html