如果在单元格中input关键字，则从另一个工作表中提取数据的代码

我有一个多页的单词本。 我有一张名为“信息”的表，其中包含数百行员工。 每个员工都在B列中分配一个员工编号; 行的其余部分（24列）包含员工的其他个人信息）。 我有另一个名为“数据”的表，只需要一组20至40人，每天都可以变化，我希望能够input员工编号（例如：SN124523）到一个名为Sheet “数据”。 然后，我希望剩下的行自动填充“Info”表中的员工信息。 我需要多达40名员工这样做，所以无论我在“数据”表的B列中select哪个单元格，我都希望在导入信息时search“信息”表单。 我已经使用VLOOKUP公式做了这个工作，但是因为多人有时使用这本书，我有时候必须删除和replace“信息”表。我总是以公式中的#REF错误结束。

我尝试了这样的一些数据作为一个试验，但我不能得到任何工作。

Sub Add_member() Dim ws As Worksheet Dim ws1 As Worksheet Dim iRow, row_count As Long Set ws = Worksheets("Info") Set ws1 = Worksheets("Data") row_count = ws.Range("B" & Rows.Count).End(xlUp).Row For iRow = 2 To row_count If ws1.Cells(iRow, 2) = ws.Cells(iRow, 2) Then ws1.Cells(iRow, 4).Value = ws.Cells(iRow, 4).Value ws1.Cells(iRow, 5).Value = ws.Cells(iRow, 5).Value ' I would need this to fill 24 columns in total. End If Next End Sub 

任何帮助非常感谢。

Answer 1

在这种情况下，我会使用一个Event_Handler 。 因此，input号码后，数据会自动更新。

假设B1是单元格，您将input要查找的数字。

将以下代码发布到WorkSheet module ，input一个数字，并在第一行显示该数字的数据

 Private Sub Worksheet_Change(ByVal Target As Range) Dim fCell As Range Dim rng As Range Application.EnableEvents = 0 Set ws = Worksheets("Info") If Not Intersect(Target, Range("B1")) Is Nothing Then Set fCell = ws.Range("B2:B1000").Find(What:=Target, After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not fCell Is Nothing Then Target.Resize(, 24).Value = fCell.Resize(, 24).Value Else MsgBox "No number exists." Range("B1:Y1").ClearContents End If End If Application.EnableEvents = 1 End Sub 

Answer 2

假设

• 员工编号是一个string（如“SN124523”）

• 总有一个员工号码

• 雇员号码在表格“数据”栏B中的连续范围内input（即在它们之间的空白）

那么你可以使用

 Sub Add_member() Worksheets("Data").Columns(2).SpecialCells(xlCellTypeConstants, xlTextValues).offset(, 2).Resize(, 24).FormulaR1C1 = "=Vlookup(RC2,Info!C2:C27,column()-1)" End Sub 

或者，如果你想摆脱公式：

 Sub Add_member() With Worksheets("Data").Columns(2).SpecialCells(xlCellTypeConstants, xlTextValues).offset(, 2).Resize(, 24) .FormulaR1C1 = "=Vlookup(RC2,Info!C2:C27,column()-1)" .value = .value End With End Sub 

当然所有的上述假设都可以被删除，代码也会相应地改变。

但上面的一个只是为了展示最短的可能

Answer 3

未经testing：

 Sub Add_member() Dim ws As Worksheet Dim ws1 As Worksheet Dim f As Range, c As Range, rng As Range Set ws = Worksheets("Info") Set ws1 = Worksheets("Data") Set rng = ws1.Range("B2", ws1.Cells(Rows.Count, 2).End(xlUp)) For Each c In rng.Cells If Len(c.Value) > 0 Then Set f = ws.Columns(2).Find(what:=c.Value, LookIn:=xlValues, _ lookat:=xlWhole) If Not f Is Nothing Then c.Offset(0, 2).Resize(1, 24).Value = _ f.Offset(0, 2).Resize(1, 24).Value End If End If Next End Sub