请教老师用VBA按排序号，自动显示另一表格中的名称及对应三列数，谢谢！

cartel

请教老师用VBA按排序号，自动显示另一表格中的名称及对应三列数，谢谢！.zip (74.16 KB, 下载次数: 10)

2024-2-2 14:13 上传

点击文件名下载附件

dragonthree

VLOOKUP？这么简单？

3190496160

Sub 取数()
With Sheets("Sheet1")
    r = .Cells(Rows.Count, 5).End(xlUp).Row
    ar = .Range("e1:i" & r)
End With
With Sheets("Sheet2")
    rs = .Cells(Rows.Count, 13).End(xlUp).Row
    .Range("n1:q" & r) = Empty
    br = .Range("m1:q" & r)
    For i = 1 To UBound(br)
        If br(i, 1) <> "" Then
            If IsNumeric(br(i, 1)) Then
                xh = br(i, 1)
                For j = 2 To UBound(ar, 2)
                    br(i, j) = ar(xh, j)
                Next j
            End If
        End If
    Next i
    .Range("m1:q" & r) = br
End With
MsgBox "ok!"
End Sub

3190496160

请教老师用VBA按排序号，自动显示另一表格中的名称及对应三列数，谢谢！.rar (21.12 KB, 下载次数: 12)

2024-2-2 14:34 上传

点击文件名下载附件

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下，类vlookup函数功能

1. Sub ykcbf()   '//2024.2.2
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("Sheet1")
   
6.         r = .Cells(.Rows.Count, "e").End(xlUp).Row
   
7.         arr = .[e1].Resize(r, 5)
   
8.     End With
   
9.     For i = 1 To UBound(arr)
   
10.         s = arr(i, 1) & "|" & arr(i, 2)
    
11.         d(s) = i
    
12.     Next
    
13.     With Sheets("Sheet2")
    
14.         r = .Cells(.Rows.Count, "m").End(xlUp).Row
    
15.         brr = .[m1].Resize(r, 5)
    
16.         For i = 1 To UBound(brr)
    
17.             s = brr(i, 1) & "|" & brr(i, 2)
    
18.             If d.Exists(s) Then
    
19.                 For j = 3 To UBound(arr, 2)
    
20.                     brr(i, j) = arr(d(s), j)
    
21.                 Next
    
22.             End If
    
23.         Next
    
24.         .[m1].Resize(r, 5) = brr
    
25.     End With
    
26.     Set d = Nothing
    
27.     Application.ScreenUpdating = True
    
28.     MsgBox "OK！"
    
29. End Sub
    

复制代码

gwjkkkkk

Option Explicit
Sub TEST5()
    Dim ar, br, cr, i&, j&, dic As Object
   
    Set dic = CreateObject("Scripting.Dictionary")
   
    With Sheets(1).[E1].CurrentRegion
        ar = .Value
        For i = 1 To UBound(ar)
            dic(ar(i, 2)) = .Cells(i, 3).Resize(, 3)
        Next i
    End With
   
    ar = Range("N1", Cells(Rows.Count, "N").End(xlUp)).Value
    ReDim br(1 To UBound(ar), 1 To 3)
    For i = 1 To UBound(ar)
        If dic.exists(ar(i, 1)) Then
            cr = dic(ar(i, 1))
            For j = 1 To UBound(cr, 2)
                br(i, j) = cr(1, j)
            Next j
        End If
    Next i
   
    Columns("O:Q").ClearContents
    [O1].Resize(UBound(br), 3) = br
    Set dic = Nothing
    Beep
End Sub

gwjkkkkk

参与一下。。。