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

 

 

僅供交流，未經許可，禁止轉載。