vlookup從不同的excel工作簿中提取信息

Question

我想用Vlookup製作一個用戶表單。信息存儲在不同的工作簿中。如何使用下面的VBA代碼將我需要的信息從不同的Excel工作簿提取到我的文本字段中？

Private Sub Textan_AfterUpdate() 

'check to see if value exists   
If WorksheetFunction.CountIf(C:\Users\poury\Desktop\ADDON Order Tool\AL010.xlsx.Sheet2.Range("B:B"), Me.Textan.Value) = 0 Then 
    MsgBox "This is an incorrect Article Number" 
    Me.Textan.Value = ""  
    Exit Sub 
End If 

With Me  
    Textan1 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 2, 0) 
    Textan2 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 3, 0) 
    Textan3 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 4, 0) 
    Textan4 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 5, 0) 
    Textan5 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 6, 0) 
    Textan6 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 7, 0) 
    Textan7 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 8, 0) 
    Textan8 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 9, 0)  
End With 

End Sub 

Answer 1

只要打開工作簿幕後：

Private Sub Textan_AfterUpdate() 

Application.Screenupdating = false 

Dim wb as Workbook 
Set wb = Workbooks.Open("C:\Users\poury\Desktop\ADDON Order Tool\AL010.xlsx") 

Dim Sheet2 as Worksheet 
Set Sheet2 = wb.Worksheets("Sheet2") 'change name as needed 

'check to see if value exists   
If WorksheetFunction.CountIf(Sheet2.Range("B:B"), Me.Textan.Value) = 0 Then 
    MsgBox "This is an incorrect Article Number" 
    Me.Textan.Value = ""  
    Exit Sub 
End If 

With Me  
    Textan1 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 2, 0) 
    Textan2 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 3, 0) 
    Textan3 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 4, 0) 
    Textan4 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 5, 0) 
    Textan5 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 6, 0) 
    Textan6 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 7, 0) 
    Textan7 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 8, 0) 
    Textan8 = Application.WorksheetFunction.VLookup(CLng(Me.Textan), Sheet2.Range("Lookup"), 9, 0)  
End With 

wb.Close false 

End Sub 

Answer 2

你可以重構你的代碼，並採取排序的文本框的名字和「查找」範圍列之間的關係的優勢來獲取

Private Sub Textan_AfterUpdate() 
    Dim rowIndex as Variant 

    Application.Screenupdating = False 

    With Workbooks.Open("C:\Users\poury\Desktop\ADDON Order Tool\AL010.xlsx").Worksheets("Sheet2").Range("Lookup") '<--| open needed workbook and reference its "Sheet2" "Lookup" range (change "Sheet2" to your actual sheet name) 
     rowIndex = Application.Match(Me.Textan.Value, .Columns(1), 0) '<--| try searching "Lookup" range first column for 'Textan' value 
     If IsError(rowIndex) Then 'check to see if value exists 
      MsgBox "This is an incorrect Article Number" 
      Me.Textan.Value = ""     
     Else 
      For iText = 1 to 8 
       Me.Controls("Textan" & iText) = .Cells(rowIndex, iText+ 1) 
      Next 
     End If 
    End With 
    ActiveWorkbook.Close False '<--| close opened workbook 
    Application.Screenupdating = True 
End Sub