Поиск терминов в столбце на всех листах и возврат имени вкладки, не удается захватить все возвращаемые имена листов.

Моя рабочая книга содержит 24 листа, мы занимаемся сопоставлением политик.

24-й лист (или вкладка) содержит колонку с диапазоном A2:1190 с терминами, такими как “AC-1”, “AC-2(2)”.

Я хочу искать эти отдельные термины на всех 24 листах рабочей книги и просто получить имя вкладки, на которой они встречаются; совпадение должно быть точным, потому что у нас также есть термины, такие как “A-19”, поэтому я не могу, чтобы “A-1” возвращал имя вкладки для “A-19”, это было бы серьезной ошибкой.

Результаты должны отображать как искомый термин, так и соответствующее имя листа, все выводы в новом листе, и если совпадение не найдено (что является случаем для 50% записей), то должно быть указано “нет”.

Для некоторых поисковых терминов они могут появляться на нескольких листах, и все они должны быть перечислены, было бы еще лучше, если бы мы могли перечислить каждое имя листа в новом столбце!

Я пробовал это с chatgpt, и он предложил VBA скрипт и вроде как что-то получилось, но это не очень хорошо!

Из вывода от chatgpt я чувствую, что это на 100% возможно сделать, но обработка ошибок вызывает опасения!

Например:

Допустим, у нас есть 6 листов: alphasheet, beta, gamma, theta, vega, searchsheet

На листе searchsheet: у нас есть A2:A1190 с терминами AC-1, AC-2, AC-2(1), AC-2(2), … AC-19, AC-19(2), … и так до SR-1

Нам нужно искать эти отдельные термины на других 5 листах и выводить имя листа, например:

Это VBA скрипт от chatgpt:

Sub SearchWorksheetsWithExactMatches()
    Dim ws As Worksheet, searchWs As Worksheet
    Dim searchRange As Range, cell As Range, foundCell As Range
    Dim resultsWs As Worksheet
    Dim term As String
    Dim firstAddress As String
    Dim outputRow As Long

    ' Настройка рабочего листа для результатов
    On Error Resume Next
    Set resultsWs = ThisWorkbook.Worksheets("Результаты поиска")
    If resultsWs Is Nothing Then
        Set resultsWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        resultsWs.Name = "Результаты поиска"
    Else
        resultsWs.Cells.Clear ' Очистить предыдущие результаты
    End If
    On Error GoTo 0
    resultsWs.Cells(1, 1).Value = "Поисковый термин"
    resultsWs.Cells(1, 2).Value = "Найдено на листах"
    outputRow = 2

    ' Установите рабочий лист и диапазон для поисковых терминов
    Set searchWs = ThisWorkbook.Worksheets("searchingsheet") ' Обновите это до правильного имени листа
    Set searchRange = searchWs.Range("A2:A1190") ' Обновите диапазон по мере необходимости

    ' Цикл по каждому поисковому термину
    For Each cell In searchRange
        If Not IsEmpty(cell.Value) Then
            term = Trim(cell.Value)
            Dim sheetsFound As String
            sheetsFound = ""

            ' Поиск по каждому рабочему листу для термина
            For Each ws In ThisWorkbook.Worksheets
                If ws.Name <> searchWs.Name And ws.Name <> resultsWs.Name Then ' Избежать листов поиска и результатов
                    With ws.UsedRange
                        Set foundCell = .Find(What:=term, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                        If Not foundCell Is Nothing Then
                            firstAddress = foundCell.Address
                            Do
                                If InStr(sheetsFound, ws.Name) = 0 Then
                                    sheetsFound = sheetsFound & ws.Name & ", "
                                End If
                                Set foundCell = .FindNext(foundCell)
                            Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
                        End If
                    End With
                End If
            Next ws

            ' Удаление завершающей запятой и добавление результатов на лист результатов
            If Len(sheetsFound) > 0 Then
                sheetsFound = Left(sheetsFound, Len(sheetsFound) - 2)
            Else
                sheetsFound = "Нет"
            End If

            resultsWs.Cells(outputRow, 1).Value = term
            resultsWs.Cells(outputRow, 2).Value = sheetsFound
            outputRow = outputRow + 1
        End If
    Next cell
End Sub