Предел матчей до трех вместо неограниченного

Question

Я использую сценарий, чтобы сопоставить один столбец (элемент #) с другим (имена файлов изображений, у которых есть элемент # где-то в нем). Я поместил совпадающие результаты в средний столбец, каждое совпадение отделяется разделителем ;.

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 изображений на элемент # и я хочу ограничить этот скрипт 3 или 4 совпадениями.

Редактировать:

Скажем, у нас есть рабочий лист, такой как:

ВышеСценарий сканирует столбец A (AMH4613A, AMH5706B и т. д.), а затем сканирует столбец C (обратите внимание, что изображение, представленное как столбец C, выглядит как столбец B) по значениям столбца A. Если есть совпадение (или значение из столбца A)произошло в некоторой части значения в столбце C) имя файла или значение из столбца C помещается рядом с соответствующим элементом # в столбце B.

Примечание Столбец C очень длинный,это список всех изображений в каталоге. Столбец A (элемент #) имеет длину около 1000 строк, а столбец C - около 5000. Таким образом, в среднем на каждый элемент приходится около 5 изображений, но не всегда.

Вывод будет выглядеть следующим образом:

Answer 1

Я бы, вероятно, сделал что-то подобное с поиском - должен сделать это тоже быстрее.

Sub Adrift()
Dim NA As Long, NC As Long, I As Long
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
        FAdd = Finder.Address
        Do
            Cells(I, "B").Value = Cells(I, "B").Value & "," & Finder.Value
            Count = Count + 1
            Set Finder = Range("C1:C" & NC).FindNext(Finder)
        Loop While Finder.Address <> FAdd And Count < 3
        Cells(I, "B").Value = Mid(Cells(I, "B").Value, 2)
    End If
Next I
End Sub

Вы можете потерять переменную count и просто посчитать запятые в строке - и вы можете сохранить это какстрока вместо того, чтобы многократно бросать ее в ячейку - это может сделать ее быстрее, если бы проблема была в скорости.

И, конечно, вариантные массивы обычно быстрее, чем find, хотя IMO - неплохой вариант использования для find.