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

Вход

Регистрация

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

 

= Мир MS Excel/Разложить число на n целых слагаемых - Мир MS Excel

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

Excel 2010
Добрый день.
Есть xls-файлик (счет-фактура), в котором список товаров. Напротив каждой позиции написано количество. Нужно: если число в столбце количество больше 200, макрос разбивает на несколько разных слагаемых, иначе оставляет число. Файлик с примером прикрепляю.
Количество позиций всегда разное.

Заранее спасибо.
К сообщению приложен файл: bat.xls(24.0 Kb)
 
Ответить
СообщениеДобрый день.
Есть xls-файлик (счет-фактура), в котором список товаров. Напротив каждой позиции написано количество. Нужно: если число в столбце количество больше 200, макрос разбивает на несколько разных слагаемых, иначе оставляет число. Файлик с примером прикрепляю.
Количество позиций всегда разное.

Заранее спасибо.

Автор - Volodya
Дата добавления - 14.03.2019 в 06:38
sboy Дата: Четверг, 14.03.2019, 09:13 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2444
Репутация: 689 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Каким алгоритмом подбирать слагаемые? Есть ли кратность? сколько слагаемых должно быть от каждых 200?


Яндекс: 410016850021169
 
Ответить
СообщениеДобрый день.
Каким алгоритмом подбирать слагаемые? Есть ли кратность? сколько слагаемых должно быть от каждых 200?

Автор - sboy
Дата добавления - 14.03.2019 в 09:13
Volodya Дата: Четверг, 14.03.2019, 14:22 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 38
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Каким алгоритмом подбирать слагаемые? Есть ли кратность? сколько слагаемых должно быть от каждых 200?

Кратности нет, главное, чтобы числа были целыми, наименьшее число должно быть больше 10. Алгоритм не знаю какой.
 
Ответить
Сообщение
Добрый день.
Каким алгоритмом подбирать слагаемые? Есть ли кратность? сколько слагаемых должно быть от каждых 200?

Кратности нет, главное, чтобы числа были целыми, наименьшее число должно быть больше 10. Алгоритм не знаю какой.

Автор - Volodya
Дата добавления - 14.03.2019 в 14:22
skais Дата: Четверг, 14.03.2019, 15:33 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 157
Репутация: 18 ±
Замечаний: 60% ±

Excel 2010
Решение.
[vba]
Код
Sub Button1_Click()
    Application.ScreenUpdating = False
    arr = Range("A3:C" & Cells(Rows.Count, "A").End(xlUp).Row)
    lr = Cells(Rows.Count, "E").End(xlUp).Row
    If lr > 2 Then Range("E3:G" & lr).Clear
    cr = 2
    Min = 10
    Max = 200
    For i = 1 To UBound(arr)
        If arr(i, 3) <= 200 Then
            Cells(cr, "E") = arr(i, 1)
            Cells(cr, "F") = arr(i, 2)
            Cells(cr, "G") = arr(i, 3)
            cr = cr + 1
        Else
            cnt = arr(i, 3)
            Do While cnt > 0
                n = Application.WorksheetFunction.Round((Max - Min + 1) * Rnd + Min, -1)
                If cnt < n Then n = cnt
                Cells(cr, "E") = arr(i, 1)
                Cells(cr, "F") = arr(i, 2)
                Cells(cr, "G") = n
                cnt = cnt - n
                cr = cr + 1
            Loop
        End If
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: bat2.xls(39.0 Kb)


Сообщение отредактировал skais - Четверг, 14.03.2019, 16:21
 
Ответить
СообщениеРешение.
[vba]
Код
Sub Button1_Click()
    Application.ScreenUpdating = False
    arr = Range("A3:C" & Cells(Rows.Count, "A").End(xlUp).Row)
    lr = Cells(Rows.Count, "E").End(xlUp).Row
    If lr > 2 Then Range("E3:G" & lr).Clear
    cr = 2
    Min = 10
    Max = 200
    For i = 1 To UBound(arr)
        If arr(i, 3) <= 200 Then
            Cells(cr, "E") = arr(i, 1)
            Cells(cr, "F") = arr(i, 2)
            Cells(cr, "G") = arr(i, 3)
            cr = cr + 1
        Else
            cnt = arr(i, 3)
            Do While cnt > 0
                n = Application.WorksheetFunction.Round((Max - Min + 1) * Rnd + Min, -1)
                If cnt < n Then n = cnt
                Cells(cr, "E") = arr(i, 1)
                Cells(cr, "F") = arr(i, 2)
                Cells(cr, "G") = n
                cnt = cnt - n
                cr = cr + 1
            Loop
        End If
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - skais
Дата добавления - 14.03.2019 в 15:33
_Boroda_ Дата: Четверг, 14.03.2019, 15:45 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 14864
Репутация: 5881 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
skais, уважайте других пользователей
Цитата Serge_007, Правила форума ()
При выкладывании решений в файле комментируйте способ решения в теле поста


Про это уже не раз копья ломали. Например вот http://www.excelworld.ru/forum/2-39176-1#259345


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщениеskais, уважайте других пользователей
Цитата Serge_007, Правила форума ()
При выкладывании решений в файле комментируйте способ решения в теле поста


Про это уже не раз копья ломали. Например вот http://www.excelworld.ru/forum/2-39176-1#259345

Автор - _Boroda_
Дата добавления - 14.03.2019 в 15:45
skais Дата: Четверг, 14.03.2019, 16:22 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 157
Репутация: 18 ±
Замечаний: 60% ±

Excel 2010
Boroda_ Вас понял.
 
Ответить
СообщениеBoroda_ Вас понял.

Автор - skais
Дата добавления - 14.03.2019 в 16:22
sboy Дата: Четверг, 14.03.2019, 17:18 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 2444
Репутация: 689 ±
Замечаний: 0% ±

Excel 2010
Рандомайз в PowerQuery

upd. файлик удалил, завтра доделаю (не сделал проверку последнего числа, пока работает не правильно)


Яндекс: 410016850021169

Сообщение отредактировал sboy - Четверг, 14.03.2019, 17:57
 
Ответить
СообщениеРандомайз в PowerQuery

upd. файлик удалил, завтра доделаю (не сделал проверку последнего числа, пока работает не правильно)

Автор - sboy
Дата добавления - 14.03.2019 в 17:18
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Разложить число на n целых слагаемых (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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