excel - VBA - Vlookup - 返回多列

Question

我正在尝试在 Excel 中使用 VBA 创建一个 Vlookup。

我想在'Sheet1'上查找'column1'与'Sheet2'上的'column2'

我还想返回 Sheet 1 - 3,4,5,6 上的多个列（来自 Sheet2）

你能帮我解决这个问题吗？

Answer 1

我认为使用 sql 查询表而不是 vlookup 会更容易、更快。

下面我展示了带有两个宏的代码： 1) 首先调用第二个宏来生成您想要的查询表。2) 其次是执行指示的 ado sql 查询语句（以 sql_stmt 字符串指示）并将其粘贴到指示的工作表和范围的子过程。

在 sql_stmt 字符串定义中，您必须将“sheetX_columnXheader”更改为适当的列标题。

如果要在不同的工作表中获得结果，则需要使用不同的第二个参数调用 sql_query 子过程。如果要获取其他列作为结果或匹配不同列上的数据，则必须将 sql_stmt 字符串更改为适当的 ado sql 查询语句。

Option Explicit
Sub matching_data()

Dim sqlstmt As String

On Error GoTo error

Application.ScreenUpdating = False

sqlstmt = "SELECT a.[sheet1_column1header], b.[sheet2_column2header], b.[sheet2_column3header], b.[sheet4_column2header] FROM [sheet1$] a LEFT JOIN [sheet2$] b ON a.[sheet1_column1header]=b.[sheet2_column1header]"
sql_query sqlstmt, "new_sheet", "A1"

'ending
Application.ScreenUpdating = True
MsgBox ("Finished")
Exit Sub

'error message
error:
MsgBox ("Unknown error")
Application.ScreenUpdating = True
End Sub


'subprocedure that executes ado sql query statement and pastes results in indicated range and sheet
Public Sub sql_query(ByVal sqlstmt As String, ByVal sheet_name As String, ByVal target1 As String)

Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim connstring As String
Dim qt As QueryTable
Dim tw_path As String
Dim is_name As Boolean
Dim sh As Worksheet

On Error GoTo error
'''adding sheet if there is no sheet with indicated name
is_name = False
For Each sh In ThisWorkbook.Worksheets
    If sh.Name = sheet_name Then is_name = True
Next
If is_name = False Then ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = sheet_name

''' connection
tw_path = ThisWorkbook.path & "\" & ThisWorkbook.Name
connstring = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & tw_path & ";Extended Properties=Excel 8.0;Persist Security Info=False"

''' making database
Set conn = New ADODB.Connection
conn.ConnectionString = connstring
conn.Open

'''executing statement
Set rs = New ADODB.Recordset
rs.Source = sqlstmt
rs.ActiveConnection = conn
rs.Open

'''saving results
ThisWorkbook.Worksheets(sheet_name).Activate
Set qt = Worksheets(sheet_name).QueryTables.Add(Connection:=rs, Destination:=Range(target1))
qt.Refresh

'''ending
ending:
If rs.State <> adStateClosed Then rs.Close
conn.Close
If Not rs Is Nothing Then Set rs = Nothing
If Not conn Is Nothing Then Set conn = Nothing
Set qt = Nothing

Exit Sub

'
error:
MsgBox ("Unknown error occured in sql query subprocedure")
GoTo ending
End Sub

请记住在 VBA 编辑器中激活“Microsoft ActiveX 数据对象 2.8 库”或更高版本（工具 -> 参考...）。请记住，每个工作表中数据的最大大小为 256 列和 65535 行。适用于 Excel 2007。

希望，这会有所帮助。