Для решения данной задачи будем применять алгоритм FFD:

1. Сортируем объекты по убыванию объема

2. Начинаем с первого объекта — размещаем его в первую коробку

3. Проверяем следующий объект:

   1. Перебираем все коробки от первой до последней

      1. Если он влезает в коробку — кладем в нее, выходим из цикла по коробкам

      2. Если не влезает ни в одну из коробок — организуем новую коробку и кладем в нее, выходим из цикла по коробкам

4. Повторяем пункт 3 для всех объектов

5. Выводим номер коробки, в который размещен объект

6. Выводим загрузку по коробкам

Итак, открыли таблицу Calc. Так, и что у меня на входе? Ну, во-первых — таблица из более чем 400 товаров вида:

Товар 1	15 000	10 000	500
Товар 2	7 000	200	700
Товар 3	1 000	500	6 000
Товар 4	200	6 000	3 000
Товар 5	7 000	200	700
Товар 6	7 000	200	700
Товар 7	7 000	200	700
Товар 8	7 000	200	700
Товар 9	7 000	200	700
Товар 10	7 000	200	700
Товар 11	7 000	200	700
Товар 12	7 000	200	700
Товар 13	7 000	200	700
Товар 14	3 000	3 000	100
Товар 15	3 000	3 000	100
Товар 16	5 000	2 000	7 000
Товар 17	1 000	500	6 000

В которой второе, третье, четвертое поля — длина, ширина и высота. Во-вторых, размеры коробок, в которые товар пакуется: 1000х12000х15000. Все размеры — в миллиметрах.

Открываем редактор OOo Basic

Макрос создаем в текущей рабочей книге

Сначала определимся с представлением переменных. Коробка и товары — объекты, которые имеют несколько параметров. Кроме того, нам придется организовывать некоторое количество объектов одинакового типа: более 400 товаров, неизвестное наперед количество коробок... Это наталкивает на мысль о том, что неплохо бы создать объекты, а потом образовать из них массив.

Часть переменных и объекты я введу вне макросов, в начале модуля, что сделает их видимыми во всех макросах модуля.

Для того, чтобы отсутствие переменной, используемой в коде вызывало ошибку, в начале модуля я укажу опцию Explicit:

Option Explicit

Объекты в OOo Basic вводятся с помощью конструкции «type … end type». Для коробки объект можно ввести так:

type TBox

' Описываем объект "ящик"

BoxLength As Long ' - длина

BoxHeight As Long ' высота

BoxWidth As Long ' ширина

Volume As Double ' объем

FreeVolume As Double ' свободный объем

end type

Внимание! Объем в миллиметрах может быть больше максимально допустимого числа для типа Long. Именно поэтому для объемов использован тип Double.

После этого, в макросе, может быть определен объект типа TBox:

Dim Box As TBox

и его свойствам присвоены некоторые значения (объект.свойство=значение):

Box.BoxLength=BoxLStandart

Объект «Товар» описываем аналогично:

type TTovar

' Товар описываем теми же линейными параметрами — длина, высота, ширина

TovLength As Long

TovHeight As Long

TovWidth As Long

Volume As Double

BoxNum As Long ' номер ящика в который положен товар

end type

Введем константы:

Const MaxRow=100000, BoxLStandart=1000, BoxHStandart=12000 ,BoxWStandart=15000

Константа MaxRow — максимальное количество товаров, остальные — линейные размеры ящика.

Там же, вне макросов я объявлю и массивы ящиков и товаров:

Dim Box(1) As TBox, Tovar(1) As Ttovar

Внимание! Оба массива — из двух элементов. Но товаров-то и коробок может быть больше? Сделано так для того, чтобы не перегружать память ненужными элементами: в макросе мы будем динамически менять количество элементов массива.

Итого, в начале модуля получаем такую последовательность:

Option Explicit

Const MaxRow=100000, BoxLStandart=1000, BoxHStandart=12000 ,BoxWStandart=15000

type TBox

BoxLength As Long

BoxHeight As Long

BoxWidth As Long

Volume As Double

FreeVolume As Double

end type

type TTovar

TovLength As Long

TovHeight As Long

TovWidth As Long

Volume As Double

BoxNum As Long

end type

Dim Box(1) As TBox, Tovar(1) As Ttovar

Смотрим на первый шаг нашего алгоритма — необходимо отсортировать товар по убыванию объема. Хорошо бы сделать это непосредственно в листе электронной таблицы. Процедуру сортировки диапазона данных я честно стибрил позаимствовал в замечательной книге Марка Александра Бейн а «Изучение программирования макросов для электронных таблиц в OpenOffice.org », которую всем настоятельно рекомендую, благо она есть в свободном (действительно — свободном!) доступе (и у нас в 817 тоже). Вот как она выглядит там:

Sub range_sort(iSortArea as String)

Dim oSortField(0) As New com.sun.star.table.TableSortField

Dim oPropertyValue(1) As New com.sun.star.beans.PropertyValue

Dim oRange as Object

oRange = ThisComponent.Sheets(0).getCellRangeByName(iSortArea)

oSortField(0).Field = 0

oSortField(0).IsAscending = True

oSortField(0).IsCaseSensitive = False

oPropertyValue(0).Name = "SortFields"

oPropertyValue(0).Value = oSortField

oPropertyValue(1).Name = "ContainsHeader"

oPropertyValue(1).Value = True

oRange.sort(oPropertyValue)

End Sub

В заголовке процедуры указано, что входной параметр для нее (iSortArea) — диапазон сортруемых данных. Для данного случая я изменил процедуру так:

Sub range_sort(iSortArea as String)

Dim oSortField(0) As New com.sun.star.table.TableSortField

Dim oPropertyValue(1) As New com.sun.star.beans.PropertyValue

Dim oRange as Object

oRange = ThisComponent.Sheets(0).getCellRangeByName(iSortArea)

oSortField(0).Field = 4

' По умолчанию - ставим сортировку по пятому полю (отсчет с нуля)-это объем товара

oSortField(0).IsAscending = False

oSortField(0).IsCaseSensitive = False

oPropertyValue(0).Name = "SortFields"

oPropertyValue(0).Value = oSortField

oPropertyValue(1).Name = ""

' Предполагается отсутствие заголовка у сортируемой таблицы, убрано ContainsHeader

oPropertyValue(1).Value = True

oRange.sort(oPropertyValue)

End Sub

Для того, чтобы при создании нового объекта «Ящик» поля заполнялись правильно создадим процедуру:

Sub InitBox(BoxIndex As Long)

Box(BoxIndex).BoxLength=BoxLStandart

Box(BoxIndex).BoxHeight=BoxHStandart

Box(BoxIndex).BoxWidth=BoxWStandart

Box(BoxIndex).Volume=Box(BoxIndex).BoxLength*Box(BoxIndex).BoxHeight*Box(BoxIndex).BoxWidth

Box(BoxIndex).FreeVolume=Box(BoxIndex).Volume

End Sub

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

Box(BoxIndex).FreeVolume=Box(BoxIndex).Volume

утверждаем, что свободный объем ящика поначалу совпадает с его общим объемом.

Теперь все готово для того, чтобы написать макрос FFD!

Сначала зададим все переменные, используемые в макросе:

Dim oSheet as Object, oCell as Object

Dim i As Long, RowCount As Long, Diapazon As String, j As Long, MaxBox As Long

Далее будет понятно, зачем какая переменная определена.

Привяжемся к конкретному листу «этой» книги (лист я назвал «Материалы»):

oSheet=thisComponent.sheets.getByName ("Материалы")

То есть, объекту oSheet мы присвоили один из листов (sheets) c именем (getByName) с именем «Материалы» этой книги (thisComponent).

Беда, мы не знаем количества товаров... Что делать?

for i=0 to MaxRow

oCell=oSheet.getCellByPosition (0,i)

if oCell.Type=com.sun.star.table.CellContentType.EMPTY then

RowCount=i-1 : Exit For

End if

Next i

В цикле от нулевой ячейки до максимально возможной (ранее мы определили MaxRow как константу) перебираем ячейки нулевого столбца (getCellByPosition):

oCell=oSheet.getCellByPosition (0,i)

oSheet — переменная, определенная ранее — лист материалы.

Если в ячейке пусто:

oCell.Type=com.sun.star.table.CellContentType.EMPTY

то переменной RowCount присваиваем значение номера предыдущей строки и

Exit For

покидаем цикл.

Работаем с объемами товаров, которые у нас еще не рассчитаны. Проведем расчет в листе, с помощью формулы. Для этого необходимо во все ячейки пятой колонки (первые четыре у нас уже заняты) ее и вставить: произведение значений в ячейках данной строки, столбца со второго по четвертый.

for i=0 to RowCount

oCell=oSheet.getCellByPosition (4,i)

oCell.Formula="=B"+CStr(i+1)+"*C"+CStr(i+1)+"*D"+CStr(i+1)

Next i

В цикле по всем строкам, соответствующим товарам

for i=0 to RowCount

получаем доступ к ячейке пятого столбца

oCell=oSheet.getCellByPosition (4,i)

и вставляем туда формулу:

oCell.Formula="=B"+CStr(i+1)+"*C"+CStr(i+1)+"*D"+CStr(i+1)

Допустим, i=1, тогда в правой части получим: "=B1*C1*D1". Верно? Да, вроде бы так.

Объемы рассчитаны, нужно сортировать товар:

Diapazon="A1:E"+CStr(RowCount+1)

range_sort(Diapazon)

В строке

Diapazon="A1:E"+CStr(RowCount+1)

«склеен» диапазон сортировки и присвоен переменной Diapazon. А в следующей выполнена процедура сортировки.

Теперь нужно считать из листа данные о товарах и записать их в соответствующий массив. Но, массив-то пределен ранее так:Tovar(1) As Ttovar. Нужно менять границы. Делается это с помощью соответствующих команд переопределения:

ReDim Preserve Tovar(RowCount) As Ttovar

А теперь заполняем массив данными из листа:

for i=0 to RowCount

Tovar(i).TovLength=oSheet.getCellByPosition (1,i).Value

Tovar(i).TovWidth=oSheet.getCellByPosition (2,i).Value

Tovar(i).TovHeight=oSheet.getCellByPosition (3,i).Value

Tovar(i).Volume=oSheet.getCellByPosition (4,i).Value

Tovar(i).BoxNum=-1

Next i

По умолчанию - номер коробки (Tovar(i).BoxNum), в которую отправился товар равен -1. Все остальные комментариев не требуют: считываются последовательно длина, ширина, высота и объем товара.

Основную часть макроса — пункт третий алгоритма я дам просто в качестве откомментированного кода:

MaxBox=0

' Пока у нас одна коробка

InitBox(0)

for i=0 to RowCount

' В цикле перебираем товары

for j=0 to MaxBox

if Tovar(i).Volume>Box(j).Volume then

oCell=oSheet.getCellByPosition (5,i)

oCell.String="Объем товара превышает объем коробки"

' Если шутники-логисты добавили в табличку товар, объем которого

' превышает объем коробки - сказали об этом

Exit For

end if

if Tovar(i).Volume<=Box(j).FreeVolume then

' Если объем текущего товара меньше свободного объема коробочки

Tovar(i).BoxNum=j

' кидаем его в эту коробку

Box(j).FreeVolume=Box(j).FreeVolume-Tovar(i).Volume

' объем свободного места уменьшаем

Exit For

' покидаем цикл по коробкам

elseif (j=MaxBox) and (Tovar(i).BoxNum=-1) then

' если же все коробки перебраны, а свободного места не нашлось

MaxBox=MaxBox+1

' добавляем коробку

Redim Preserve Box(MaxBox) As TBox

' добавляем в массив еще один элемент

InitBox(MaxBox)

' инициализируем его

Tovar(i).BoxNum=MaxBox

' бросаем туда товар

Box(MaxBox).FreeVolume=Box(MaxBox).FreeVolume-Tovar(i).Volume

' место в коробке уменьшается на объем товара

Exit For

' рвем когти к следующему товару

end if

Next j

Next i

Теперь выводим все, что навычисляли в лист электронной таблицы:

for i=0 to RowCount

' вывод номеров ящиков в таблицу

if Tovar(i).BoxNum>-1 then

oCell=oSheet.getCellByPosition (5,i)

oCell.Value=Tovar(i).BoxNum

end if

Next i

for i=0 to MaxBox

' добавляем таблицу с ящиками и незаполненным в ящике месте

oCell=oSheet.getCellByPosition (7,i)

oCell.Value=i

oCell=oSheet.getCellByPosition (8,i)

oCell.Value=Box(i).FreeVolume

Next i

Книга с макросом — прилагается. Скачать пример

Недостаток этого макроса в том, что... О! Первый курс, а какие здесь недостатки с точки зрения суровой реальности? Как их решить? Что добавить в макрос? Это задача из разряда «минус один». Присоединяйтесь...