显示一行数据

当我search组织代码时，我需要从Excel电子表格中的一行数据来显示。 我可以得到一个单元格显示，但不是信息的行。 如果组织不匹配任何文件，则会显示一条错误消息。

这是我到目前为止：

Option Explicit Sub findData() Dim GCell As Range Dim Txt$, MyPath$, MyWB$, MySheet$ Dim myValue As String Txt = InputBox("What Organization do you want to search for?") MyPath = "C:\users\DKane\My Documents\" MyWB = "EVHC Master Hiring Spreadsheet range find.xlsx" MySheet = ActiveSheet.Name Application.ScreenUpdating = False Workbooks.Open Filename:=MyPath & MyWB Set GCell = ActiveSheet.Cells.Find(Txt) With ThisWorkbook.ActiveSheet.Range("A1") .Value = "Organization" .Offset(0, 1).Value = "Location" .Offset(1, 0).Value = GCell.Value myValue = GCell.Offset(0, 1).Value .Offset(1, 1).Value = myValue .Columns.AutoFit .Offset(1, 1).Columns.AutoFit End With ActiveWorkbook.Close savechanges:=False Application.ScreenUpdating = True Exit Sub 

和标题行信息（在工作表顶部）：

 HR Contact (person who can answer questions about this org) Region Organization (Company.Location Code.Department) Location in Oracle format Job Title PT/FT Local Tax Element Benefits Code Benefits Code Comments (if multiple, how can MHRC determine what benefit code should be used?) Mailstop Internal Transfer? Payroll ID Local Tax Element Union Code Union Code Comments (if multiple, how can MHRC determine when to use which code?) Uniform Allowance PTO Date Drug Screen Provider (eg Quest, internal, Concentra) Sign-on bonus instructions (including under what circumstances each is used, if multiple) 

Answer 1

看到这个代码。 从我读到的内容来看，我认为它会给你你所要求的。

我在代码本身发表了一些评论（我可能不太明显），所以你可以理解。

 Option Explicit Sub findData() Dim GCell As Range Dim Txt$, MyPath$, MyWB$, MySheet$ Dim myValue As String Dim wbMain As Workbook Set wbMain = ThisWorkbook Txt = InputBox("What Organization do you want to search for?") MyPath = "C:\users\DKane\My Documents\" MyWB = "EVHC Master Hiring Spreadsheet range find.xlsx" Dim ws As Worksheet Set ws = wbMain.Sheets("Sheet1") ' change as needed 'MySheet = ws.Name Application.ScreenUpdating = False Dim wbSearch As Workbook Set wbSearch = Workbooks.Open(Filename:=MyPath & MyWB) Set GCell = wbSearch.Sheets(1).Cells.Find(Txt) 'assumes its first worksheet in workbook If Not GCell Is Nothing Then 'test if it exists 'get last column Dim lCol As Long lCol = wbSearch.Range("A1").End(xlToRight).Column 'assumes contigous column headers 'copy headers wbSearch.Range(.Range(.Range("A1"), .Cells(1, lCol))).Copy ws.Range("A1") 'copy org rows wbSearch.Range(.Range(.Cells(GCell.Row, 1), .Cells(GCell.Row, lCol))).Copy ws.Range("B1") ws.Columns.AutoFit Else MsgBox "Org Not Found" End If wbSearch.Close savechanges:=False Application.ScreenUpdating = True End Sub