Question

除了查找优先级部分外，这张表基本上都很有效... 我需要它在相应的工作表中找到匹配的值，然后返回它所在的行号，这样我就可以将值粘贴到找到的单元格右侧的单元格中。

然而，当我运行这个VBA（我必须完全注释掉它以防止完全破坏excel表格）时，单元格是1关闭，并且这些randoms在表格的底部卷起（“no”男人的土地“）。我已经尝试增加和减少保存行标识的值，看看它是否能修复我的问题的那部分，但没有这样的运气。无论如何，这里的代码是破碎的方式：

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

您可以尝试的一件事是MATCH命令。您可以按如下方式在VBA中访问它：

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

这将在您的函数中返回您的行号。

Answer 2

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

将find函数与行计数器结合使用已解决了我的问题!!

感谢迈克指出我朝着一个更好的方向发展（从某种意义上说，如果没有你发光的话我就不会深入挖掘）

Excel VBA在同一本书的另一个工作表中查找匹配的单元格

2 个答案: