簡體   English   中英

VBA-Vlookup-返回多列

[英]VBA - Vlookup - Return Multiple Columns

我正在嘗試在Excel中使用VBA創建Vlookup。

我想在“ Sheet1”上查找“ column1”,而在“ Sheet2”上查找“ column2”

我還想返回工作表1-3、4、5、6的多列(來自工作表2)

你能幫我嗎?

我認為使用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一起使用。

希望這會有所幫助。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM