Excel VBA在同一本書中的另一張表中找到匹配單元格

Question

基本上這張表單工作得很好，除了查找優先級部分... 我需要它找到相應表單中的匹配值，然後返回它的行號在，以便我可以將值粘貼到找到的單元格右側的單元格中。但是，當我運行這個VBA（我不得不完全評論它，以防止完全破壞Excel表格），單元格是關閉的，並且這些單元格在表單的底部捲起來（在「無人區」）。我試圖增加和減少持有行標識的值，看看它是否能解決我的問題的部分，但沒有這樣的運氣。 總之，這裏的代碼在它的破時尚：

Private Sub Workbook_Open() 
'connection to database 
Dim userEmpId As String 
Dim sSQL As String 
userEmpId = InputBox(Prompt:="Employee ID.", Title:="ENTER EMPLOYEE ID", _ 
      Default:="A1JW7ZZ") 
sSQL = "SELECT * FROM OP_TRAIN; " 
Dim rs As ADODB.Recordset 
Dim cn As ADODB.Connection 
Set cn = New ADODB.Connection 
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=I:\MANUFACTURING\Six Sigma Projects\Green Belt Projects 2012\Hebron Training Plan\3m hebron training.accdb;Persist Security Info=False" 
Set rs = New ADODB.Recordset 
rs.Open sSQL, cn 
ActiveWorkbook.Sheets("Employee Training").Cells(1, 1).CopyFromRecordset rs 
rs.Close 
Set rs = Nothing 
cn.Close 
Set cn = Nothing 
Worksheets("Employee Training").Activate 
Dim Bottom As Integer 
Dim CopyRange As String 
Bottom = CInt(Cells(Rows.Count, "A").End(xlUp).Row) 'initializes the bottom of the list (total number of entries) 
CopyRange = "A1:G" & Bottom 'Total data range 

Do Until Bottom = 0 'loop until out of data 
    ActiveSheet.Cells(Bottom, 1).Select 'selects column A of the current row 
    If (Selection.Text <> userEmpId) Then 
     Range(CopyRange).Rows(Bottom).Delete Shift:=xlUp 
    End If 
    Bottom = Bottom - 1 
Loop 
Bottom = CInt(Cells(Rows.Count, "A").End(xlUp).Row) 'initializes the bottom of the list (total number of entries) 
Dim FoundRow As Integer 
Do Until Bottom = 0 'loop until out of data 
    'ActiveSheet.Cells(Bottom, 2).Select 'selects column B of the current row 
    Select Case Selection.Text 
     Case "1A" 
      ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row 
      FoundRow = FindPriority(Selection.Value) 
      'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row 
      Selection.Copy 
      Worksheets("OP1A-OP1B").Activate 
      Cells(FoundRow, 4).Select 
      Selection.PasteSpecial Paste:=xlPasteValues, _ 
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Case "1B" 
      ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row 
      FoundRow = FindPriority(Selection.Value) 
      'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row 
      Selection.Copy 
      Worksheets("OP1B-OP1C").Activate 
      Cells(FoundRow, 4).Select 
      Selection.PasteSpecial Paste:=xlPasteValues, _ 
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Case "1C" 
      ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row 
      FoundRow = FindPriority(Selection.Value) 
      'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row 
      Selection.Copy 
      Worksheets("OP1C-OP2A").Activate 
      Cells(FoundRow, 4).Select 
      Selection.PasteSpecial Paste:=xlPasteValues, _ 
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Case "2A" 
      ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row 
      FoundRow = FindPriority(Selection.Value) 
      'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row 
      Selection.Copy 
      Worksheets("OP2A-OP2B").Activate 
      ' Cells(FoundRow, 4).Select 
      Selection.PasteSpecial Paste:=xlPasteValues, _ 
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Case "2B" 
      ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row 
      FoundRow = FindPriority(Selection.Value) 
      'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row 
      Selection.Copy 
      Worksheets("OP2B-OP2C").Activate 
      Cells(FoundRow, 4).Select 
      Selection.PasteSpecial Paste:=xlPasteValues, _ 
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Case "2C" 
      ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row 
      FoundRow = FindPriority(Selection.Value) 
      'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row 
      Selection.Copy 
      Worksheets("OP2C-OP3A").Activate 
      Cells(FoundRow, 4).Select 
      Selection.PasteSpecial Paste:=xlPasteValues, _ 
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Case "3A" 
      ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row 
      FoundRow = FindPriority(Selection.Value) 
      'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row 
      Selection.Copy 
      Worksheets("OP3A-OP3B").Activate 
      Cells(FoundRow, 4).Select 
      Selection.PasteSpecial Paste:=xlPasteValues, _ 
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Case "3B" 
      ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row 
      FoundRow = FindPriority(Selection.Value) 
      'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row 
      Selection.Copy 
      Worksheets("OP3B-OP3C").Activate 
      Cells(FoundRow, 4).Select 
      Selection.PasteSpecial Paste:=xlPasteValues, _ 
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Case "3C" 
      ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row 
      FoundRow = FindPriority(Selection.Value) 
      'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row 
      Selection.Copy 
      Worksheets("OP3C-SOP").Activate 
      Cells(FoundRow, 4).Select 
      Selection.PasteSpecial Paste:=xlPasteValues, _ 
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    End Select 
    Worksheets("Employee Training").Activate 
    Bottom = Bottom - 1 
Loop 
End Sub 

這是有問題的代碼

Function FindPriority(priority As Integer) As Integer 
Dim ws As Excel.Worksheet 
Dim FoundCell As Excel.Range 
Set ws = ActiveSheet 
Set FoundCell = ws.Range("C:C").Find(what:=priority, lookat:=xlWhole) 
FindPriority = FoundCell.Row 
End Function 

Answer 1

ActiveSheet.Range("C:C").Find(priority, , xlValues, xlWhole).Row 

使用find函數連接到行計數器求解我的問題！

感謝邁克指着我更好的方向（從某種意義上說我永遠不會已經挖更深沒有你閃亮的一些光）

Answer 2

有一兩件事你可以嘗試是在比賽的命令。您在VBA中訪問它如下：

FindPriority = Application.WorksheetFunction.Match(priority,ws.Range("C:C"),0) 

這將返回您的函數中的行號。