Excel VBA 동일한 서적의 다른 시트에서 일치하는 셀을 찾음

Question

기본적으로이 시트는 찾기 우선 순위 부분을 제외하고 훌륭하게 작동합니다 ... 해당 시트 내에서 일치하는 값을 찾은 다음 행 번호를 반환해야합니다. 그래서 셀의 오른쪽에 값을 붙여 넣을 수 있습니다.

그러나이 VBA를 실행할 때 (전체적으로 Excel 시트를 완전히 지우지 말고 주석으로 처리해야합니다.) 셀은 1 개 꺼져 있고 시트 맨 아래에 이러한 무작위로 감겨 있습니다 (" 아무 남자의 땅도 아니다 "). 나는 행 정체성을 유지하는 값을 내 이슈의 그 부분을 고칠지를 알기 위해 값을 늘리거나 줄이려고 시도했지만, 그런 행운은 없다. 그것이 깨진 패션의에서 어쨌든, 여기에 코드입니다 :

이

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 

행 카운터와 함께 찾기 기능을 사용합니다. 내 문제 해결! 마이크가 더 나은 방향으로 날을 가리키는에 대한 응답을

Answer 2

한 가지가 MATCH 명령입니다 문제가있는 코드입니다. 다음과 같이 VBA에서 액세스합니다.

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

이렇게하면 함수에있는 행 번호가 반환됩니다.