Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Циклы, распределение при ограничениях - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Циклы, распределение при ограничениях (Макросы/Sub)
Циклы, распределение при ограничениях
Elvira66 Дата: Четверг, 26.07.2018, 17:26 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 95
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день!
Помогите пожалуйста решить задачу!
файл приложила, задачу описала в файле.
К сообщению приложен файл: 9413409.xlsx(12.4 Kb)
 
Ответить
СообщениеДобрый день!
Помогите пожалуйста решить задачу!
файл приложила, задачу описала в файле.

Автор - Elvira66
Дата добавления - 26.07.2018 в 17:26
_Boroda_ Дата: Четверг, 26.07.2018, 18:41 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 13245
Репутация: 5454 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Так нужно?
Предваряя вопросы, сразу с комментариями написал
[vba]
Код
Sub zagr()
    Application.ScreenUpdating = 0
    r1_ = Cells(Rows.Count, 1).End(3).Row 'последняя заполненная ячейка
    If r1_ > 1 Then
        Cells(2, 1).Resize(r1_ - 1, 3).Clear 'очистка предыдущего диапазона
    End If
    arn = Sheets("Нужно").Range("A1").CurrentRegion.Offset(1).Value 'массив Нужно, нижняя строка лишняя
    are = Sheets("Есть").Range("A1").CurrentRegion.Offset(1).Value 'массив Есть, нижняя строка лишняя
    arm = Sheets("Нужно").Range("A1").CurrentRegion.Offset(1).Value 'Массив Можем (ненужное там потом изменим)
    Set slov = CreateObject("Scripting.Dictionary") 'словарь
    With slov
        For i = 1 To UBound(are) - 1 'цикл по Есть
            .Item(are(i, 1)) = are(i, 2) 'заполняем словарь
        Next i
        For j = 1 To UBound(arn) - 1 'цикл по Нужно
            ne_ = .Item(arn(j, 2)) 'сколько осталось
            If ne_ > 0 And arn(j, 3) Then 'если осталось >0 и нужно не 0, то
                k_ = k_ + 1 'счетчик +1
                If ne_ > arn(j, 3) Then 'если осталось больше, чем нужно
                    arm(k_, 3) = arn(j, 3) 'пишем из Нужно
                Else 'иначе
                    arm(k_, 3) = ne_ 'пишем сколько осталось
                End If
                arm(k_, 2) = arn(j, 2) 'заполняем второй столбец
                arm(k_, 1) = arn(j, 1) 'и первый столбец
                .Item(arn(j, 2)) = ne_ - arn(j, 3) 'в словаре уменьшаем соотв. количество
            End If
        Next j
    End With
    Cells(2, 1).Resize(k_, 3) = arm 'выгружаем на лист только нужный кусок массива
    Application.ScreenUpdating = 1
End Sub
[/vba]
К сообщению приложен файл: 9413409_1.xlsm(25.1 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТак нужно?
Предваряя вопросы, сразу с комментариями написал
[vba]
Код
Sub zagr()
    Application.ScreenUpdating = 0
    r1_ = Cells(Rows.Count, 1).End(3).Row 'последняя заполненная ячейка
    If r1_ > 1 Then
        Cells(2, 1).Resize(r1_ - 1, 3).Clear 'очистка предыдущего диапазона
    End If
    arn = Sheets("Нужно").Range("A1").CurrentRegion.Offset(1).Value 'массив Нужно, нижняя строка лишняя
    are = Sheets("Есть").Range("A1").CurrentRegion.Offset(1).Value 'массив Есть, нижняя строка лишняя
    arm = Sheets("Нужно").Range("A1").CurrentRegion.Offset(1).Value 'Массив Можем (ненужное там потом изменим)
    Set slov = CreateObject("Scripting.Dictionary") 'словарь
    With slov
        For i = 1 To UBound(are) - 1 'цикл по Есть
            .Item(are(i, 1)) = are(i, 2) 'заполняем словарь
        Next i
        For j = 1 To UBound(arn) - 1 'цикл по Нужно
            ne_ = .Item(arn(j, 2)) 'сколько осталось
            If ne_ > 0 And arn(j, 3) Then 'если осталось >0 и нужно не 0, то
                k_ = k_ + 1 'счетчик +1
                If ne_ > arn(j, 3) Then 'если осталось больше, чем нужно
                    arm(k_, 3) = arn(j, 3) 'пишем из Нужно
                Else 'иначе
                    arm(k_, 3) = ne_ 'пишем сколько осталось
                End If
                arm(k_, 2) = arn(j, 2) 'заполняем второй столбец
                arm(k_, 1) = arn(j, 1) 'и первый столбец
                .Item(arn(j, 2)) = ne_ - arn(j, 3) 'в словаре уменьшаем соотв. количество
            End If
        Next j
    End With
    Cells(2, 1).Resize(k_, 3) = arm 'выгружаем на лист только нужный кусок массива
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 26.07.2018 в 18:41
Elvira66 Дата: Четверг, 26.07.2018, 18:57 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 95
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Да именно так, спасибо. задача решена!)))) :)
 
Ответить
СообщениеДа именно так, спасибо. задача решена!)))) :)

Автор - Elvira66
Дата добавления - 26.07.2018 в 18:57
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Циклы, распределение при ограничениях (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!