修改VBA脚本以将匹配限制为3个，而不是无限个吗？

Question

[我正在使用脚本来根据另一列（图像文件名，其中包含项目＃的位置）来匹配一列（项目＃），并将匹配的结果放在中间一列中，每个匹配项之间用一个定界符。就我而言，是;，但是我可以按照标题中的说明将匹配项限制为3吗？

Sub Adrift()
    Dim NA As Long, NC As Long, v As String, I As Long, J As Long
    Dim v2 As String
    NA = Cells(Rows.Count, "A").End(xlUp).Row
    NC = Cells(Rows.Count, "C").End(xlUp).Row
    For I = 2 To NA
        v = Cells(I, "A").Value
        v2 = ""
        For J = 2 To NC
            If InStr(Cells(J, "C").Value, v) > 0 Then
                v2 = v2 & "," & Cells(J, "C").Value
            End If
        Next J
        Cells(I, "A").Offset(0, 1).Value = Mid(v2,2)
    Next I
End Sub

问题是我每个项目最多有30张图片，而我们无法处理近30张图片，我们希望有一种简便的方法将此脚本限制为3或4个匹配项。想知道是否有简单的方法吗？

编辑：

说我们有一个类似的工作表：

上面的脚本扫描A列（AMH4613A，AMH5706B等），然后扫描C列（请注意，图像看上去好像C列是B列，不确定为什么要像这样切断它） ，并且如果存在匹配项（或C列中的值的某些部分中出现了A列中的值），则C列中的文件名或值将与B列中的匹配项＃相邻。

注 C列很长，它是目录中所有图像的列表。 A列（项目编号）大约1000行，而C列大约5000行。因此，每个项目平均大约有5张图像。但并非总是

输出将是：

Answer 1

我可能会用finds做这样的事情-也应该使其更快。

Sub Adrift()
Dim NA As Long, NC As Long, v As String, I As Long, J As Long
Dim v2 As String
Dim Finder As Range, FAdd As String, Count As Integer
NA = Cells(Rows.Count, "A").End(xlUp).Row
NC = Cells(Rows.Count, "C").End(xlUp).Row
For I = 2 To NA
    Count = 0: Cells(I, "B").Value = ""
    Set Finder = Range("C1:C" & NC).Find(Cells(I, "A").Value, LookAt:=xlPart)
    If Not Finder Is Nothing Then
        Do While Finder.Address <> FAdd And Count < 3
            Cells(I, "B").Value = Cells(I, "B").Value & "," & Finder.Value
            Count = Count + 1
            FAdd = Finder.Address
            Set Finder = Range("C1:C" & NC).FindNext(Finder)
        Loop
        Cells(I, "B").Value = Mid(Cells(I, "B").Value, 2)
    End If
Next I
End Sub