Question

我需要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 (e.g. 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

显示一行数据

1 个答案: