Вставка максимально приближенного значения путем исключения

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Вставка максимально приближенного значения путем исключения (О возможности прописывать максимально приближенное значение)

Вставка максимально приближенного значения путем исключения

nicalf

Дата: Суббота, 10.11.2012, 23:27 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 10

Репутация: 0 ±

Замечаний: 0% ±

Доброго времени суток, уважаемые форумчане!
В прошлый раз Ваша помощь меня очень выручила, надеюсь, что и в этом случае Вы мне поможете.
Ситуация следующая, представьте, что есть 134 разных по вместимости ящика, и есть 19 видов товаров, которых нужно рассортировать по этим ящикам в зависимости от их вместимости, причем, если ящик № 5 заполнен товаром № 15, то товар № 15 больше ни в один ящик уже попасть не должен, причем товары должны быть рассортированы в порядке убывания, к сожалению ящики сортировать нельзя, более конкретный пример вложен в данное сообщение, как должно быть-выделено красным. Уже голову сломал над тем, как это сделать. Буду Вам признателен, если сможете помочь.

К сообщению приложен файл: -2-.xlsx (14.7 Kb)

Сообщение отредактировал nicalf - Суббота, 10.11.2012, 23:32

Ответить

Hugo

Дата: Воскресенье, 11.11.2012, 01:11 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3691

Репутация: 790 ±

Замечаний: 0% ±

365

Странно, сошлось smile

[vba]

Code

Sub tt()
     Dim a(), b(), i&, ii&

     a = [f2:f135].Value
     b = [b2:c20].Value
     ReDim c(1 To UBound(a), 1 To 2)

     For i = 1 To UBound(a)
         If Len(a(i, 1)) > 1 Then
             For ii = 1 To UBound(b)
                 If b(ii, 2) > 0 Then
                     If a(i, 1) >= b(ii, 2) Then
                         c(i, 1) = b(ii, 2)
                         c(i, 2) = b(ii, 1)
                         b(ii, 2) = 0
                         Exit For
                     End If
                 End If
             Next
         End If
     Next

     [i2].Resize(UBound(c), 2) = c
End Sub

[/vba]