用VBA代替VLOOKUP多列取数给不连续的多列赋值

hzruziniu

用VBA代替VLOOKUP：
要求：
用VBA数组或字典把Sheet2的通讯费补贴、高温补贴和社会保险费三列分别赋值给Sheet1的对应三列。
多列赋值.rar (5.48 KB, 下载次数: 171)

2014-12-4 19:30 上传

点击文件名下载附件

chxw68

1. Sub test()
   
2.   Dim d As Object
   
3.   Dim r%, i%
   
4.   Dim arr, brr
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("sheet2")
   
7.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
   
8.     arr = .Range("b3:f" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       d(arr(i, 1)) = i
    
11.     Next
    
12.   End With
    
13.   With Worksheets("sheet1")
    
14.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
15.     brr = .Range("b4:t" & r)
    
16.     For i = 1 To UBound(brr)
    
17.       If d.Exists(brr(i, 1)) Then
    
18.         n = d(brr(i, 1))
    
19.         brr(i, 10) = arr(n, 3)
    
20.         brr(i, 11) = arr(n, 4)
    
21.         brr(i, 14) = arr(n, 5)
    
22.       End If
    
23.     Next
    
24.     .Range("b4").Resize(UBound(brr), UBound(brr, 2)) = brr
    
25.   End With
    
26.       
    
27.       
    
28. End Sub
    

复制代码

liulang0808

Sub 按钮2_Click()
    Application.ScreenUpdating = False
    arr = Sheets(2).[b2].CurrentRegion
    For j = 2 To UBound(arr)
        If Len(arr(j, 2)) > 0 Then '
            Set Rng = Columns(3).Find(arr(j, 2), lookat:=xlWhole)
            If Not Rng Is Nothing Then
                r = Rng.Row
                Cells(r, "k") = arr(j, 3)
                Cells(r, "l") = arr(j, 4)
                Cells(r, "o") = arr(j, 5)
            End If
        End If
    Next j
    Application.ScreenUpdating = True
End Sub

chxw68

参见附件。

liulang0808

具体见附件内容

hzruziniu

chxw68 发表于 2014-12-4 19:43
参见附件。

谢谢chxw68 老师的帮助，效果非常好，而且用了字典速度又快，可惜你的代码把表中的合计列的公式也重新赋值了，这张表是模似表，此表要反复使用，因此公式必须保留。

hzruziniu

liulang0808 发表于 2014-12-4 19:44
具体见附件内容

感谢iulang0808老师的热心帮助，达到了预期的效果，再次谢谢你。

zax010

Sub zz()
    Set d = CreateObject("Scripting.Dictionary")
    arr = Sheet2.Range("B2").CurrentRegion
    For i = 2 To UBound(arr)
        d(arr(i, 2)) = Array(arr(i, 3), arr(i, 4), arr(i, 5))
    Next
    With Sheet1
        For i = 4 To 23
            If d.exists(.Cells(i, 3).Value) Then
                s = d(.Cells(i, 3).Value): .Cells(i, 11) = s(0): .Cells(i, 12) = s(1): .Cells(i, 15) = s(2)
            End If
        Next
    End With
End Sub

zax010

>>>>>>>>>>>>>>>>>>>>>>>
多列赋值.rar (10.73 KB, 下载次数: 158)

2014-12-4 20:13 上传

点击文件名下载附件

chxw68

纠正了覆盖公式的问题。