如何在VBA的getrowindex函数中实现单元格字符串部分匹配查找？

问题背景 #

使用VBA的.Find函数查找双条件行时，原函数仅支持完全匹配且区分大小写。执行rowindex_1 = getrowindex(sysnum, "Wavelength Range", "ModTst,FunctionalTest,ShpPrp")无法定位到C列包含FunctionalTest的行，需要修改函数实现：B列值精确匹配目标参数名，同时C列单元格包含指定路由关键字，无需传入完整的C列字符串。

原始函数代码 #

Function getrowindex(WDnum As Variant, parametername As String, routingname As String)
Dim parameter_row As Range, ws As Worksheet, rowname As Range, addr As String

Set ws = ThisWorkbook.Worksheets(WDnum)
Set rowname = ws.Columns("B").Find(What:=parametername, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True) 

If Not rowname Is Nothing Then 
        addr = rowname.Address 
    Do
        If rowname.Offset(0, 1).Value = routingname Then 
            getrowindex = rowname.Row
            Exit Do 
        End If
        Set rowname = ws.Columns("B").FindNext(after:=rowname)
    Loop While rowname.Address <> addr 
End If
End Function

待修正的更新代码（存在未定义变量问题） #

Function getrowindex(WDnum As String, parametername As String, routingname As String, Optional partialFirst As Boolean = False, Optional partialSecond As Boolean = False) 
Dim ws As Worksheet, rowname As Range, addr As String, copy As Long, Output As Integer, rngParam As Range, rngRouting As Range

Set ws = ThisWorkbook.Worksheets(WDnum)

Set rowname = ws.Columns(Parameter).Find(What:=parametername, Lookat:=IIf(partialFirst, xlPart, xlWhole), LookIn:=xlFormulas, MatchCase:=True) 

If Not rowname Is Nothing Then ' check that parametername can be found
    addr = rowname.Address 
    If partialSecond Then routingname = "*" & routingname & "*" 
    Do
        If rowname.EntireRow.Columns(RoutingStep).Value Like routingname Then ' check column C for cell with routingname
            If rngParam Is Nothing Then 
                Set rngParam = ws.Range(rowname, ws.Cells(Rows.Count, Parameter))
                Set rngRouting = rngParam.EntireRow.Columns(RoutingStep)
                If Application.WorksheetFunction.CountIfs(rngParam, parametername, rngRouting, routingname) > 1 Then ' counts the number of cells within given range that meet multiple criteria (in this case that have parametername and routingname)
                    MsgBox "This row combination of " & parametername & " and " & routingname & _
                           " appears in multiple lines. Check before running again.", vbCritical ' prints if there a multiple rows with same case sensitive name
                    Stop
                End If
            End If
            
            getrowindex = rowname.Row ' row index for the combination of parameter and routing step
            Exit Do
        End If
    Else
        MsgBox "Row combination " & parametername & " and " & routingname & " cannot be found. Check before running again.", vbCritical
        Stop
       End If

        Set rowname = ws.Columns(Parameter).FindNext(After:=rowname)
    Loop While rowname.Address <> addr ' loop back to check find operation for parametername
Else ' else if parametername row cannot be found send message
    MsgBox parametername & " row could not be found. Check before running again.", vbCritical
    Stop
End If

End Function

修正后的最终函数代码 #

Function getrowindex(WDnum As Variant, parametername As String, routingname As String, _
                    Optional partialParam As Boolean = False, Optional partialRouting As Boolean = False) As Long
    Dim ws As Worksheet, rowname As Range, addr As String
    Dim paramCol As String, routingCol As String
    
    ' 定义目标列：B列为参数列，C列为路由列
    paramCol = "B"
    routingCol = "C"
    
    ' 检查工作表是否存在
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(WDnum)
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "工作表" & WDnum & "不存在", vbCritical
        getrowindex = 0
        Exit Function
    End If
    
    ' 查找参数列中的目标值，支持精确/部分匹配，区分大小写
    Set rowname = ws.Columns(paramCol).Find(What:=parametername, _
                    Lookat:=IIf(partialParam, xlPart, xlWhole), _
                    LookIn:=xlFormulas, MatchCase:=True)
    
    If Not rowname Is Nothing Then
        addr = rowname.Address
        Do
            ' 判断路由列值：支持精确/部分匹配，区分大小写
            Dim routingVal As String
            routingVal = rowname.EntireRow.Columns(routingCol).Value
            
            Dim matchFound As Boolean
            If partialRouting Then
                ' 区分大小写的包含匹配，使用StrComp+InStr
                matchFound = (InStr(1, routingVal, routingname, vbBinaryCompare) > 0)
            Else
                ' 精确匹配
                matchFound = (StrComp(routingVal, routingname, vbBinaryCompare) = 0)
            End If
            
            If matchFound Then
                ' 检查是否存在多匹配
                Dim matchCount As Long
                matchCount = Application.WorksheetFunction.CountIfs( _
                                ws.Columns(paramCol), parametername, _
                                ws.Columns(routingCol), IIf(partialRouting, "*" & routingname & "*", routingname))
                ' 注意：CountIfs默认不区分大小写，如需区分需调整，此处保留原逻辑提示
                If matchCount > 1 Then
                    MsgBox "参数" & parametername & "与路由关键字" & routingname & "的组合存在多行匹配，请检查数据", vbCritical
                    getrowindex = 0
                    Exit Function
                End If
                getrowindex = rowname.Row
                Exit Do
            End If
            
            Set rowname = ws.Columns(paramCol).FindNext(After:=rowname)
        Loop While rowname.Address <> addr
        
        ' 如果循环结束未找到匹配
        If getrowindex = 0 Then
            MsgBox "未找到参数" & parametername & "与路由关键字" & routingname & "的匹配行", vbCritical
        End If
    Else
        MsgBox "未找到参数" & parametername & "的行", vbCritical
        getrowindex = 0
    End If
End Function

关键修改说明 #

1. 修复未定义变量：明确指定参数列（B列）和路由列（C列），避免原代码中Parameter、RoutingStep未定义的错误
2. 灵活匹配控制：通过可选参数partialParam和partialRouting分别控制B列、C列是否使用部分匹配，默认B列精确匹配、C列可按需开启部分匹配
3. 区分大小写的包含匹配：使用InStr结合vbBinaryCompare实现区分大小写的包含判断，替代原代码中Like（默认不区分大小写）的问题
4. 优化错误处理：移除Stop语句，改用返回0并弹窗提示，避免中断程序执行；新增工作表存在性检查
5. 调用方式适配：现在只需传入rowindex_1 = getrowindex(sysnum, "Wavelength Range", "FunctionalTest", partialRouting:=True)即可实现需求

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