使用Range.Find在不同列查找多值的VBA代码问题排查

需求：查找同时包含“Tuning Range”与“Test-Config”的行索引，再重复查找同时包含“Tuning Range”与“FunctionalTest”的行索引。

问题：现有VBA代码中，rowindex = getrowindex(sysnum, "Tuning Range", "Test-Config")可正常运行，但rowindex_1 = getrowindex(sysnum, "Tuning Range", "FunctionalTest")返回值为0，且getrowindex函数的第二个Set语句对应的消息框未弹出，该段代码无输出。

原getrowindex函数关键片段 #

Set parameter_row = Worksheets(WDnum).Range("C:C").Find(What:=routingname, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True)
    If Not parameter_row.EntireRow.Find(What:=parametername, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True) Is Nothing Then
        getrowindex = parameter_row.Row
    MsgBox "Row value" & getrowindex
    Exit Function
    End If

Main子程序 #

Public Sub Main()
Dim wb As Workbook, ws As Worksheet, i As Range, dict As Object, sysrow As Integer, sysnum As String, wsName As String
Dim wbSrc As Workbook
Dim SDtab As Worksheet
Dim Value As Long, colindex As Long, rowindex As Long, rowindex_1 As Long

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1") 

Set wbSrc = Workbooks.Open("Q:\QSpecification and Configuration Document.xlsx")
Set dict = CreateObject("scripting.dictionary")
    For Each i In ws.Range("E2:E15").Cells 
        sysnum = i.Value
        sysrow = i.Row
        syscol = i.Column

    If sysnum = "" Then
    End If
If Not dict.Exists(sysnum) Then ' 检查唯一值是否已存在，再添加到字典
    dict.Add sysnum, True
    If Not SheetExists(sysnum, ThisWorkbook) Then
        wsName = i.EntireRow.Columns("D").Value 
        If SheetExists(wsName, wbSrc) Then 
            wbSrc.Worksheets(wsName).Copy After:=ws 
            wb.Worksheets(wsName).name = sysnum 
        End If
        
 Sheets(1).Select
colindex = getcolumnindex(ws, "Tuning Range")
Value = getjiradata(ws, sysrow, colindex)

rowindex = getrowindex(sysnum, "Tuning Range", "Test-Config")
rowindex_1 = getrowindex(sysnum, "Tuning Range", "FunctionalTest")

    Else
        MsgBox "Sheet " & sysnum & " already exists"
    End If
End If

Next i
End Sub

SheetExists函数 #

Function SheetExists(SheetName As String, wb As Workbook)
    On Error Resume Next
    SheetExists = Not wb.Sheets(SheetName) Is Nothing
End Function

getcolumnindex函数 #

Function getcolumnindex(sht As Worksheet, colname As String) 
Dim paramname As Range
Set paramname = sht.Range("A1:Z2").Find(What:=colname, Lookat:=xlWhole, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=True)
    If Not paramname Is Nothing Then
        getcolumnindex = paramname.Column
    End If
End Function

getjiradata函数 #

Function getjiradata(sht As Worksheet, WDrow As Integer, parametercol As Long) 
    getjiradata = sht.Cells(WDrow, parametercol)
End Function

完整原getrowindex函数 #

Function getrowindex(WDnum As Variant, parametername As String, routingname As String) As Long 
Dim parameter_row As Range

Set parameter_row = Worksheets(WDnum).Range("B:B").Find(What:=parametername, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True)
    If Not parameter_row.EntireRow.Find(What:=routingname, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True) Is Nothing Then
        getrowindex = parameter_row.Row
    MsgBox "Parameter row value is " & getrowindex
Exit Function
    End If
Set parameter_row = Worksheets(WDnum).Range("C:C").Find(What:=routingname, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True)
    If Not parameter_row.EntireRow.Find(What:=parametername, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True) Is Nothing Then
        getrowindex = parameter_row.Row
    MsgBox "Row value" & getrowindex
    Exit Function
    End If
End Function

1. 空对象访问错误：原getrowindex函数中，当第一行Range("B:B").Find没找到parametername（即"Tuning Range"）时，parameter_row为Nothing，此时直接访问parameter_row.EntireRow会触发运行时错误，程序会跳过该分支后续代码，直接跳到函数末尾返回默认值0，根本不会执行第二个Set语句的查找逻辑。
2. 大小写严格匹配：Find方法启用了MatchCase:=True，若目标表格中"FunctionalTest"的大小写与传入参数不一致，会导致查找失败。
3. 逻辑漏洞：第一个分支的Exit Function会直接终止函数，若第一个查找逻辑不满足但第二个逻辑满足的情况，无法被触发。

修改getrowindex函数，先判断查找对象是否存在，再执行后续行内查找，同时优化逻辑避免提前终止：

Function getrowindex(WDnum As Variant, parametername As String, routingname As String) As Long 
Dim parameter_row As Range
Dim foundCell As Range

' 第一个查找逻辑：B列找parametername，再在行内找routingname
Set parameter_row = Worksheets(WDnum).Range("B:B").Find(What:=parametername, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True)
If Not parameter_row Is Nothing Then
    Set foundCell = parameter_row.EntireRow.Find(What:=routingname, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True)
    If Not foundCell Is Nothing Then
        getrowindex = parameter_row.Row
        MsgBox "Parameter row value is " & getrowindex
        Exit Function
    End If
End If

' 第二个查找逻辑：C列找routingname，再在行内找parametername
Set parameter_row = Worksheets(WDnum).Range("C:C").Find(What:=routingname, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True)
If Not parameter_row Is Nothing Then
    Set foundCell = parameter_row.EntireRow.Find(What:=parametername, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True)
    If Not foundCell Is Nothing Then
        getrowindex = parameter_row.Row
        MsgBox "Row value" & getrowindex
        Exit Function
    End If
End If

' 若都没找到，返回0（可根据需求修改默认值）
getrowindex = 0
End Function

额外检查项：

• 确认目标工作表中"FunctionalTest"的拼写、大小写与传入参数完全一致
• 确保sysnum对应的工作表确实存在且包含目标数据

内容的提问来源于stack exchange，提问作者user20114520