Arrays 将子例程转换为可在公式中使用的函数

我对函数不是很在行，希望有人能帮我转换。我将插入带有宏的公式

我曾尝试使用公式，但在找到2个或更多匹配项时遇到问题

该函数将通过如下宏插入：

ws1.Range(Cells(x, spec), Cells(lRow, spec)).Formula = "=IFERROR(IF(OR(MID(RC[-3],SEARCH(""-"",RC[-3])+1,SEARCH(""-"",RC[-3],SEARCH(""-"",RC[-3])+1)-SEARCH(""-"",RC[-3])-1) = ""WP"",MID(RC[-3],SEARCH(""-"",RC[-3])+1,SEARCH(""-"",RC[-3],SEARCH(""-"",RC[-3])+1)-SEARCH(""-"",RC[-3])-1)=""DO""),""A15"",MID(RC[-3], FIND(CHAR(1),SUBSTITUTE(RC[-3],""-"",CHAR(1)," & aft & "))+1, FIND(CHAR(1),SUBSTITUTE(RC[-3],""-"",CHAR(1)," & aft + 1 & ")) - FIND(CHAR" & _
        "(1),SUBSTITUTE(RC[-3],""-"",CHAR(1)," & aft & "))-1)),"""")" & ""

Sub Test()

Dim ws1, ws2 As Worksheet
Dim SrchRng As Range, cel As Range
Dim SrchStr As String
Dim myList, tbl As Object
Dim arr As Variant
Dim i, x As Integer
Dim val as String

Set ws1 = ThisWorkbook.Sheets("Index")
Set ws2 = ThisWorkbook.Sheets("Data Entry")

Set SrchRng = ws1.Range("A2:A30")
Set myList = CreateObject("System.Collections.ArrayList")
SrchStr = ws2.Range("AB7")

For Each cel In SrchRng
    If InStr(1, SrchStr, cel.Value, vbTextCompare) > 0 Then
        myList.Add cel.Value
        arr = myList.Toarray
        
    End If
Next cel

'######### Need to compare string length and keep the highest value ##########
For i = LBound(arr) To UBound(arr)
    If IsNull(x) Or Len(arr(i)) > x Then
        x = Len(arr(i))
        val = arr(i)
    End If
Next i

ws2.Range("AE7") = val

Debug.Print x
Debug.Print a

Set ws1 = Nothing
Set ws2 = Nothing
Set SrchRng = Nothing
Set myList = Nothing
                     
End Sub

 


 

---

由于更新了问题而编辑

双循环将对数据进行一对一搜索，以确保捕获任何重复条目并正确标记

假设与格式有一定的一致性，这将查找搜索条件和

-

（即：“A12UG-”）。这将消除用“A12”触发“A12UG”

要调用函数，请将调用分配给变量。ie:

varName=updateAE（）

输出：

---

我刚刚将代码更新为非常类似的内容。见上文。我在将字符串值写回工作表时遇到问题，因此我创建了另一个变量。现在我需要把它写成一个函数，插入到一个公式中。不幸的是不是。我以前用过一个公式来求第n个“-”。但是，此工作簿现在将在公司范围内使用，并且格式会有所不同，因此公式不再是一个选项。其想法是创建一个带有规范代码（列表）的表，并搜索字符串以查看它是否包含列表项之一。请参阅旧公式的代码开头。如果这是一个愚蠢的问题，很抱歉，但我该如何称呼它？我对功能不是很在行！@机械人，它工作，但我有奇怪的行为

updateAE（）=Range（“AE7”）

工作正常，但我得到了“运行时错误424:需要对象”Range（“AE7”）.Value=updateAE（）'用正确的值填充一个范围，并且没有错误，然后一些值消失。知道是什么原因吗？

Function updateAE()
    Dim ws1: Set ws1 = ThisWorkbook.Sheets("Index")
    Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Data Entry")
    Dim srchRng As Range, indexRng As Range, indexCel As Range, srchCel As Range
    Dim i As Integer
    Dim count As Integer
    Dim indexLRow, srchLRow As Long
    
    indexLRow = ws1.Cells(ws2.Rows.count, "A").End(xlUp).Row
    srchLRow = ws2.Cells(ws2.Rows.count, "AB").End(xlUp).Row
    
    Set indexRng = ws1.Range("A1:A" & indexLRow)
    Set srchRng = ws2.Range("AB3:AB" & srchLRow)
    count = 1
    
    On Error Resume Next
    For Each indexCel In indexRng
        For Each srchCel In srchRng
            If InStr(1, srchCel, indexCel & "-") > 0 And Len(indexCel) > 0 Then
                ws2.Range("AE" & count + 2) = indexCel
            End If
            count = count + 1
        Next srchCel
        count = 1
    Next indexCel
End Function