VBA - Vlookup - возвращает несколько столбцов

Question

Я пытаюсь создать Vlookup, используя VBA в Excel.

Я хочу посмотреть «column1» на «Лист1» против «COLUMN2» на «Лист2» ​​

Я также хочу, чтобы вернуться несколько столбцов на листе 1 - 3,4,5,6 (от Лист2)

Можете ли вы мне помочь?

Answer 1

Я думаю, было бы проще и намного быстрее использовать таблицу sql query вместо 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 

Не забудьте активировать "данных Microsoft ActiveX объекта 2.8 библиотеки" или выше, в редакторе VBA (инструменты -> ссылки ...). Имейте в виду, что максимальный размер данных в каждом листе составляет 256 столбцов и 65535 строк. Работает с Excel 2007.

Надеюсь, это поможет.