vlookup从不同的Excel工作簿中提取信息
我想用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
只需在幕后打开工作簿：
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
您可以重构代码，并利用您的文本框名称和“查找”范围列之间的关系进行检索
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