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

Answer 3

Application.ScreenUpdating = False

Dim wb As Workbook
Dim rowIndex As Variant
Set wb = Workbooks.Open("F:\My DAFM Project_v1\Employee Data Base File_2019.xlsx").Worksheets("EmpData").Range("A:E")
rowIndex = Application.Match(Me.TextBox9.Value.Cells(y, 11), 0)

Dim EmpData As Worksheet
Set EmpData = wb.Worksheets("EmpData") 'changed file name as needed

If IsError(rowIndex) Then
Me.TextBox9.Value = ""

'check to see if value exists
If WorksheetFunction.CountIf(EmpData.Range("A:e"), Me.TextBox9.Value) = 0 Then
    MsgBox "This is an Incorrect SAP ID"
    Me.TextBox9.Value = ""

    Exit Sub
End If

With Me
    TextBox10.Text = Application.WorksheetFunction.VLookup(CLng(Me.TextBox9), EmpData.Range("b:E"), 3, 0)
    TextBox11.Text = Application.WorksheetFunction.VLookup(CLng(Me.TextBox9), EmpData.Range("b:E"), 4, 0)
    TextBox12.Text = Application.WorksheetFunction.VLookup(CLng(Me.TextBox9), EmpData.Range("b:E"), 5, 0)

End With

wb.Close False

End Sub

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

3 个答案: