excel 用于查找单元格是否包含部分匹配的查找函数(如果适用)

nc1teljy 于 2022-11-18 发布在其他

关注(0)|答案(2)|浏览(168)

我正在寻找一个函数，它接受两个输入参数，boardtype和subsysnum，然后找到具有该特定组合的行索引。但是，如果subsysnum列为空，则继续。只有某些情况下会有subsysnum值。boardtype必须是精确匹配的。为了实现该函数，到目前为止，我已经编写了：boardtype和subsysnum都定义为上述字符串。调用函数时定义的column将为3或5
到目前为止，我已经调用了其中包含查找表的工作表，并且相信我已经找到了boardtype的行索引，现在我只需要合并如果可以在第二列中找到subsysnum值，则找到行组合索引，否则继续使用空白的第二列来找到查找值。

使用上表，例如我的boardtype = AX-6和我的subsysnum = WD 1234 TEST，我希望宏获取行索引9，因为subsysnum = WD 1234包含在子系统编号WD 1234 TEST中。如果subsysnum = WD 298588试验，则返回的行索引应为8，因为它包含在值中。最后，如果在第2列中找不到subsysnum值，则它应该返回AX-6的行索引7，旁边是空白单元格。
这就是我目前所尝试的，但是，我没有得到GetClock的任何值

Function GetClock(boardtype As String, subsysnum As String, column As Long, Optional partialFirst As Boolean = False) As Variant  
    Dim wbSrc As Workbook, ws As Worksheet, r1 As Range, r2 As Range, board_range As Range, firstAddress As String
    FunctionName = "GetClock"
    Set wbSrc = Workbooks.Open("C:\Documents\LookupTable.xlsx")
    Set ws = wbSrc.Worksheets("Clock")

    Set r1 = ws.Columns(1)
    Set r2 = ws.Columns(2)

With r1
        Set board_range = r1.Find(What:=boardtype, LookAt:=xlWhole, LookIn:=xlFormulas, MatchCase:=True) ' find board type row
            If Not board_range Is Nothing Then
                firstAddress = board_range.Address ' save board type address
            Else
                    ErrorMsg = ErrorMsg & IIf(ErrorMsg = "", "", "") & SectionName & ": " & "Board " & boardtype & " could not be found in lookup table" & vbNewLine
                Exit Function
            End If
        Do While Not board_range Is Nothing 
            Set subsysnum_range = r2.Find(What:=subsysnum, LookIn:=xlFormulas, LookAt:=IIf(partialFirst, xlPart, xlWhole), MatchCase:=True)
                    GetClock = ws.cells(board_range.row, column).value
            Exit Function 

        Set board_range = r1.Find(boardtype, board_range)
            If board_range.Address = firstAddress Then
                GetClock = ws.cells(Range(firstAddress).row, column).value 
                If GetClock = 0 Then
                    ErrorMsg = ErrorMsg & IIf(ErrorMsg = "", "", "") & SectionName & ": " & "lookup table missing value" & vbNewLine
                End If
                Exit Function
            End If
     Loop
End With
End Function

UPDATE：其中Column(13)表示Data Sheet中存储了subsysnum的列

Function GetClock(boardtype As String, subsysnum As String, column As Long, Optional partialFirst As Boolean = False) As Double  
Dim wbSrc As Workbook, ws As Worksheet, r1 As Range, r2 As Range, board_range As Range, firstAddress As String, subsysnum_range As Range, rng_board As Range, rng_subsys As Range
FunctionName = "GetExternalClock"
Set wbSrc = Workbooks.Open("C:\Documents\LookupTable.xlsx")
Set ws = wbSrc.Worksheets("Clock")

Dim wb As Workbook, dataws As Worksheet
Set wb = Workbooks("S93.xlsm")
Set dataws = wb.Worksheets("Data Sheet")
Set r1 = ws.Columns(1)
Set r2 = ws.Columns(2)

With r1
    Set board_range = r1.Find(What:=boardtype, LookAt:=xlWhole, LookIn:=xlFormulas, MatchCase:=True) ' find board type row
        If Not board_range Is Nothing Then
            firstAddress = board_range.Address ' save board type address
        Else
                ErrorMsg = ErrorMsg & IIf(ErrorMsg = "", "", "") & SectionName & ": " & "Board " & boardtype & " could not be found in lookup table" & vbNewLine
            Exit Function
        End If
Dim subsys As Range, cell As String
    Do While Not board_range Is Nothing ' while board type is not nothing look for value of cell in column 2
        For Each subsys In Range("B3:B12")
            cell = subsys.value
            Set subsys_rng = dataws.Columns(13).Find(What:=cell, LookIn:=xlFormulas, LookAt:=IIf(partialFirst, xlPart, xlWhole), MatchCase:=True)
            If cell = "" Then
            GoTo Skip
            Else
                GetClock= ws.cells(subsys_rng.row, column).value
            End If
 
 Skip:
    Next subsys
    Exit Function

     'if intersect.value does not equal sysnum, then it will set board_range below only after it has checked every matching cell in column 1
    Set board_range = r1.Find(boardtype, board_range)
        If board_range.Address = firstAddress Then
            GetClock= ws.cells(Range(firstAddress).row, column).value ' boardtype row index with empty cell in r2
            If GetClock= 0 Then
                ErrorMsg = ErrorMsg & IIf(ErrorMsg = "", "", "") & SectionName & ": " & "lookup table missing value" & vbNewLine
            End If
            Exit Function
        End If
    Loop
End With
Exit Function
End Function

| 主板|子系统|最小值|最大值|最小值|最大值|
| - -|- -|- -|- -|- -|- -|
| AX系列||10个|四十|10个|四百|
| AX-11突击步枪||10个|四百|10个|四百|
| AX-12突击步枪||100个|七百五十|100个|七百五十|
| AX-13突击步枪||10个|五百五十|10个|五百五十|
| AX-4突击步枪||10个|四百|10个|四百|
| AX-6突击步枪||一百二十五|五百五十|一百二十五|五百五十|
| AX-6突击步枪|WD 298588型|四十|五百个|四十|五百个|
| AX-6突击步枪|WD 1234型|一个|2个|三个|四个|
| AX-7突击步枪||一百二十五|七百五十|一百二十五|七百五十|
| AX-8突击步枪||一百二十五|五百五十|一百二十五|五百五十|

excel

来源：https://stackoverflow.com/questions/74465802/find-function-to-find-if-cell-contains-a-partial-match-if-applicable

2条答案

按热度按时间

uyto3xhc1#

请检查下一个函数：

Function GetClock(wbSrc As Workbook, boardtype As String, subsysnum As String, Optional column As Long = 0) As Long
   Dim ws As Worksheet, lastR As Long, arr, i As Long, dict As Object
   
    Set ws =  wbSrc.Worksheets("Clock")  'set the sheet where the data to be processed exists
    lastR = ws.Range("A" & ws.rows.count).End(xlUp).row 'last row in A:A
    
    arr = ws.Range("A2:F" & lastR).Value2 'place the range in an array for faster iteration/processing
    
    Set dict = CreateObject("Scripting.Dictionary") 'set the necessary dictionary
    For i = 1 To UBound(arr) 'iterate between the array rows
        'if first array column is = boardtype and subsysnum exists in the second column (B:B):
        If arr(i, 1) = boardtype And InStr(arr(i, 2), subsysnum) > 0 Then
             If column = 0 Then 'if no column parameter
                dict(1) = i + 1 'it returns the matching row (+ 1 because the array starts from the second row ("A2:F" & lastR)
             Else
                dict(1) = arr(i, column) 'it returns the value in the 'column' column
             End If
        ElseIf arr(i, 1) = boardtype Then 'if not the above two matches, but only a match between first column and `boardtype':
           If column = 0 Then
                dict(2) = i + 1 'it returns the matching row
             Else
                dict(2) = arr(i, column) 'it returns the value in the 'column' column
             End If
        End If
    Next i
    If dict.Exists(1) Then 'if both matches have been done:
        GetClock = dict(1)  'it returns the dict(1) value
    ElseIf dict.Exists(2) Then 'if only a match of the first column:
       GetClock = dict(2)   'it returns the dict(2) value
    End If
End Function

可通过以下方式对其进行测试：

Sub testGetClock()
   Dim wbSrc As Workbook
   On Error Resume Next
     Set wbSrc = Workbooks("LookupTable.xlsx") 'try setting the open workbook
    On Error GoTo 0
    'if it is not open (being Nothing), set it by opening:
    If wbSrc Is Nothing Then Set wbSrc = Workbooks.Open("C:\Documents\LookupTable.xlsx")
    
   Debug.Print GetClock(wbSrc, "AX-6", "WD298588")
   Debug.Print GetClock(wbSrc, "AX-6", "WD1234")
   Debug.Print GetClock(wbSrc, "AX-6", "WD1234", 3)
End Sub

如果使用column参数，并且返回值可能是字符串，则函数返回值必须从Long更改为Variant ...
现在，如果没有匹配，则返回零（0）。
请在测试后发送一些反馈

赞(0）回复(0）举报 2022-11-18

rm5edbpk2#

数组上的简单循环更易于管理，沿着在调用之间缓存查找表：

Sub Tester()
    Debug.Print GetClock("AX-6", "missing", 3)            '125
    Debug.Print GetClock("AX-6", "WD1234", 3)             '1
    Debug.Print GetClock("AX-6", "WD298588", 3)           '40
    Debug.Print GetClock("AX-6", "WD1234Test", 3)         '125
    Debug.Print GetClock("AX-6", "WD1234Test", 3, True)   '1
End Sub

Function GetClock(boardtype As String, subsysnum As String, column As Long, _
                  Optional partialSubSys As Boolean = False) As Variant
    
    Static data As Variant
    Dim r As Long, rNoSub As Long, rMatchSub As Long, rMatch As Long, wldCard As String
    
    If IsEmpty(data) Then 'data not already cached?
        With Workbooks.Open("C:\Documents\LookupTable.xlsx")
            data = .Worksheets("Clock").Range("A1").CurrentRegion.Value
            .Close False
        End With
    End If
    
    wldCard = IIf(partialSubSys, "*", "") 'using a wildcard?
    For r = 2 To UBound(data, 1)
        If data(r, 1) = boardtype Then
            If Len(data(r, 2)) = 0 And rNoSub = 0 Then
                rNoSub = r       'first matched line with no subsystem listed
            ElseIf subsysnum Like data(r, 2) & wldCard Then  '<<FIXED
                rMatchSub = r    'subsystem matched
                Exit For         'stop checking
            End If
       End If
    Next r
    
    rMatch = IIf(rMatchSub > 0, rMatchSub, rNoSub) 'prefer two-part match...
    If rMatch > 0 Then 'any match (one- or two-part) ?
        GetClock = data(rMatch, column)
    Else
        GetClock = CVErr(xlErrNA)
        'populate error message as needed
    End If
End Function

赞(0）回复(0）举报 2022-11-18

我来回答

excel 用于查找单元格是否包含部分匹配的查找函数(如果适用)

2条答案

相关问题

热门标签

最新问答