Сбор данных с нескольких листов по заданному критерию

[didrou]

Здравствуйте! Нужна помощь в понимании способа сбора данных с нескольких листов по заданному параметру в один лист.
Необходимо в лист "Закупки" формировать список, состоящий из ложек, вилок, ножей, материалов из которых они сделаны и цвета окраса (данные берутся из листов "Ложки", "Вилки", "Ножи"). И всё это только для объекта, указанного в ячейке «B1» листа "Закупки".Основная книга с формами.ods
Во вложенном файле на листе "Закупки" указан пример как должно выглядеть в итоге.

[bigor]

Здравствуйте

С такими таблицами и как вы хотите только если макросом.
Немножко более упрощенный вариант формулами (под красным текстом). "Дырки" между строк убираются фильтром

[didrou]

Благодарю за труд, Bigor. Немного не то. Тоже пробовал подобным образом. Надо бы в виде макроса, если кто умеет и есть желание.

[bigor]

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

Код Выделить Развернуть

Sub Select_
dim Datao()
dim Datai(100)
oDoc=ThisComponent
Start=oDoc.Sheets(3).getCellByPosition(0,3)
Etalon=oDoc.Sheets(3).getCellByPosition(1,0).getString()
o=0
for i=0 to oDoc.Sheets.Count-2
    Sheet= ThisComponent.Sheets(i)
    Range = Sheet.getCellRangeByPosition(0,0,5,GetLast(Sheet,"A1",0))
    Data = Range.getDataArray()
    for j=0 to Ubound(Data)
        s=Data(j)
        if  s(0) = Etalon  Then
            DataO=array((oDoc.Sheets(i).Name),(s(2)),(s(3)))
            DataI(o)=(datao())
            o=o+1
        end if
    next j
next i
ReDim Preserve DataI(o-1)
Range1=oDoc.Sheets(3).getCellRangeByPosition(0,3,2,Ubound(Datai)+3)
Range1.setDataArray(Datai)
End Sub



'функция определения последнего столбца и строки в неразрывном диапазоне
'параметры Лист, адрес ячейки, которая находится в неразрывном диапазоне, 0 - ищем строку, 1 - ищем столбец
'автор JohnSUN
'
Function getLast(oSheet as Variant, sCellAddress As String, lastColumn As Boolean) As Long
Dim oCursor As Variant
Dim aRAddress As New com.sun.star.table.CellRangeAddress
    oCursor = oSheet.createCursorByRange(oSheet.getCellRangeByName(sCellAddress))
    oCursor.collapseToCurrentRegion()
    aRAddress = oCursor.getRangeAddress()
    If lastColumn Then
        getLast = aRAddress.EndColumn
    Else
        getLast = aRAddress.EndRow
    EndIf
End Function

[didrou]

Благодарю, Bigor! То, что надо

[bigor]

И вот на эту строчку dim Datai(100) обратите внимание, она задает максимальное число найденных объектов, т.е. если у вас будет их больше то выскочит ошибка о выходе за пределы. Можно было задать сразу 0, и потом каждый раз через ReDim Preserve увеличивать на 1.

Еще ошибка выплыла, если объект число, лечится заменой строки  if  s(0) = Etalon  Then
на    if  cstr(s(0)) = Etalon  Then

[didrou]

Хорошо, учёл.