Excel中的自定义功能

Question

我正在尝试创建一个自定义函数。我有2列A和B都包含文本。在C2中，当我编写该函数时，它将检查单词是否匹配，即使顺序不同或是否与A列的所有行都部分匹配，如果找到，它将在C2中写入B2的值，否则写“ Match Not Found” 。我已经编写了程序，但是它的行为异常并且未返回正确的值。请帮忙。

    Function slookup(stext As String)
    Dim chtext() As String
    Dim stext1() As String

    Dim lastrow, wrdcount, wrdcount1, c, j, k As Long

    lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

    MsgBox lastrow
    For c = 2 To lastrow
        k = 0
        chtext() = Split(stext, " ")
        wrdcount = UBound(chtext()) + 1

        stext1 = Split(ActiveSheet.Range("A" & c).Value)
        wrdcount1 = UBound(stext1) + 1
            If wrdcount = wrdcount1 Then

                For n = 0 To wrdcount - 1
                    For j = 0 To wrdcount - 1
                        If StrComp(chtext(n), stext1(j), vbTextCompare) = 0 Then
                            k = k + 1
                        End If
                    Next
                Next

                If k = wrdcount Then
'
                    ActiveSheet.Range("C2").Value = stext
                    Exit Function
                End If
            End If
    Next
    If k <> wrdcount Then
        ActiveSheet.Range("C2").Value = "No Match Found"
    End If

End Function

Answer 1

好的，我发现了这个问题，更多的是故障。我正在做所有事情，但我不想手动返回值，而是只想手动写入值。找到答案并纠正程序，现在我将尝试部分匹配。

Function slookup(stext As String)
'Application.Volatile (True)
    Dim chtext() As String
    Dim stext1() As String
    Dim stext2 As String
    stext2 = stext
    Dim lastrow, wrdcount, wrdcount1, c, j, k As Integer

    lastrow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row


    For c = 2 To lastrow
        k = 0
        chtext() = Split(stext, " ")
        wrdcount = UBound(chtext()) + 1
'        MsgBox wrdcount

        stext1 = Split(Sheets(1).Range("A" & c).Value)
        wrdcount1 = UBound(stext1()) + 1
            If wrdcount = wrdcount1 Then

                For n = 0 To wrdcount - 1
                    For j = 0 To wrdcount1 - 1
'                        MsgBox chtext(n) & " - " & stext1(j)
                        If StrComp(chtext(n), stext1(j), vbBinaryCompare) = 0 Then
                            k = k + 1
'                            Debug.Print k
                        End If
                    Next
                Next
'                MsgBox k & " - " & wrdcount
                If k = wrdcount Then
                    slookup = stext2
                    Exit Function
                End If
            End If
    Next

If k <> wrdcount Then
    slookup = "No Match Found"
End If


End Function