Excel VBA добавить имя листа в массив, созданный из всей строки

Question

У меня есть функция поиска, которая циклически просматривает рабочие книги и таблицы Excel и использует Cells.Find, возвращая массив со всеми строками, соответствующими шаблону поиска. Проблема в том, что по мере роста файлов в каталоге я теряю, в какой рабочей книге / рабочей таблице были найдены записи. Я не могу понять, как изменить временный диапазон, чтобы ввести имя рабочей таблицы / рабочей книги, не разбивая весь массив. Я пытался добавить имя листа в качестве элемента массива, но транспонировать не нравится эта идея.

Это текущий код:

   Dim myDir As String, fn As String, ws As Worksheet, r As Range
Dim a(), n As Long, x As Long, myTask As String, ff As String, temp
myDir = Range("P2").Value
Debug.Print Range("P2").Value
If Dir(myDir, 16) = "" Then
    MsgBox "No such folder path", 64, myDir
    Exit Sub
End If
myTask = InputBox("Enter Search String * accepted")
If myTask = "" Then Exit Sub
x = Columns.Count ' <---- Active worksheet count of all columns
fn = Dir(myDir & "*.xls*")
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
Do While fn <> ""
    With Workbooks.Open(myDir & fn, 0)
        For Each ws In .Worksheets ' <- ws is worksheet object ws.Name to return current search worksheet
            Set r = ws.Cells.Find(myTask, , , 1) ' <- Actual find return cells address or Nothing object if not found
            If Not r Is Nothing Then
                ff = r.Address '<- Address of cell where the search was matched
                Do
                    n = n + 1
                    temp = r.EntireRow.Value ' <- take entire row if the cell was found
                    ReDim Preserve temp(1 To 1, 1 To x) ' <- preserve temp data i dynamic array basically one dimensional array of cells, which will become a item in array a
                    ReDim Preserve a(1 To n)
                    a(n) = temp '<- insert temp array as item in array a
                    Set r = ws.Cells.FindNext(r) '<- after finding first mach in the worksheet check if later there is something to matching
                Loop While ff <> r.Address '<- loop through worksheet until we come back to the cell address we initially found
            End If
        Next
        .Close False
    End With
    fn = Dir
Loop
With ThisWorkbook.Sheets("IP_Info").Rows(1)
    .CurrentRegion.ClearContents
    If n > 0 Then
        .Resize(n).Value = _
        Application.Transpose(Application.Transpose(a))
    Else
        MsgBox "Not found", , myTask
    End If
End With

Answer 1

С этим дизайном вы не можете. В вашем временном массиве столько же записей, сколько столбцов в Excel (поэтому ReDim Preserve temp (от 1 до 1, 1 до x) не требуется), поэтому нет места для дополнительной информации, которую можно записать в строку с помощью транспонирования.

Одна вещь, которую вы можете сделать, это использовать второй массив для хранения книги и имени листа. Используйте n в качестве индекса, который соответствует строке в массиве a и массиву, содержащему рабочую книгу и лист в другом массиве.

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

если вам не нужна полная строка, а только значение найденной ячейки, вы можете выполнить следующую

::
a(n) = Array(r.Parent.Parent.Name, r.Parent.Name, r.Row, r.Column, r.Value)
:: 

запись на лист

With ThisWorkbook.Sheets("IP_Info")
    .UsedRange.ClearContents
    if n > 0 then
        .Cells(1, 1).Resize(n, 5).Value = Application.Transpose(Application.Transpose(a))
    end if
end with