vba程序实现vlookup函数的功能

本函数通过vba程序实现vlookup函数的功能，但是不需要对匹配列进行排序操作，较为方便，如果有兴趣的同学可以下来测试一下。

对程序有什么建议也欢迎在评论区提出哦~，反正我只是初学者，向大佬们低头。

Sub 测试()
   '
   '本程序可通过两个表格第一列进行数据的匹配，表1（a）和表2（b，数据表）。
   '
   '
   '
            
            Dim csa, csb, csc As String
            Dim csx, csy, csz As Integer

            Set csmytable1 = Worksheets("Sheet2") 'A表
            Set csmytable2 = Worksheets("Sheet3") 'B表
            
            csz = Application.WorksheetFunction.CountA(csmytable1.Range("a1:cc1"))
            ReDim lieming(1 To csz) As String
            For i = 1 To csz 'A表的标题头
                        lieming(i) = csmytable1.Cells(1, i)
            Next
                '以下程序当a表中的列名字与b表中的列名字相同时，则a表中该列单元格=b表中的该列单元格'
            csy = Application.WorksheetFunction.CountA(csmytable2.Range("a1:cc1"))
            ReDim lieming2(1 To csz) As String 'B表的标题头
            For n = 1 To csy
                lieming2(n) = csmytable2.Cells(1, n)
            Next
            ReDim cs(1 To csz) As Integer
            '本循环将表A中第一列的顺序对应到B表第一列该标题所在的列号，记录在数组cs中
            For m = 1 To csz
                For q = 1 To csy
                    If lieming(m) = lieming2(q) Then
                            cs(m) = q
                    End If
                Next
            Next
            x = 42  'A表中的数据行数；Application.WorksheetFunction.CountA(mytable2.Range("c1:c65536"))
            z = Application.WorksheetFunction.CountA(csmytable2.Range("c1:c65536")) 'B表中的数据行数
            ReDim pipei(1 To z) As String '用数组记录B表中的关键字列的数据，用于与A表中的关键字数据进行匹配
            For l = 1 To z
                pipei(l) = csmytable2.Cells(l, "A")
            Next
            For n = 2 To x 'A表
                For y = 2 To z 'B表
                        csc = csmytable1.Cells(n, "D") 'D与上一个循环中的A为相同的关键字列名
                        If csc <> "" And pipei(y) = csc Then
                                                    
                            For m = 1 To csz
                                csmytable1.Cells(n, m) = csmytable2.Cells(y, cs(m))
                            Next
                        End If
                Next
            Next

End Sub

 

 

仅供交流，未经许可，禁止转载。