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

Вход

Регистрация

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

 

= Мир MS Excel/Вычислить сумму некоторого заданного числа значений - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вычислить сумму некоторого заданного числа значений (Макросы/Sub)
Вычислить сумму некоторого заданного числа значений
Bob6320 Дата: Среда, 08.11.2023, 00:09 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Здавствуйте

Нужно вычислить сумму некоторого заданного числа значений, равного требуемому или большему, и количество этих значений.

Например
Есть некоторые числа: 102, 234, 356.
Есть целевая сумма, например:
Вариант 1: 120
Вариант 2: 1778
Вариант 3: 849

и т.д.

Нужно получить результат:

Вариант 1: Нужно получить сумму, близкую к числу (равному) 120 или более. Это 234 - 1 шт.

Вариант 2: Нужно получить сумму, близкую к числу (равному) 1578 или больше. Это 356 - 5 шт.

Вариант 3: Нужно получить сумму, близкую к числу (равному) 849 или больше. Это 356 - 2 шт. и 234 -1 шт.
К сообщению приложен файл: wrong_calculation.xlsm (17.6 Kb) · 5001044.jpg (26.9 Kb)


Сообщение отредактировал Bob6320 - Среда, 08.11.2023, 00:14
 
Ответить
СообщениеЗдавствуйте

Нужно вычислить сумму некоторого заданного числа значений, равного требуемому или большему, и количество этих значений.

Например
Есть некоторые числа: 102, 234, 356.
Есть целевая сумма, например:
Вариант 1: 120
Вариант 2: 1778
Вариант 3: 849

и т.д.

Нужно получить результат:

Вариант 1: Нужно получить сумму, близкую к числу (равному) 120 или более. Это 234 - 1 шт.

Вариант 2: Нужно получить сумму, близкую к числу (равному) 1578 или больше. Это 356 - 5 шт.

Вариант 3: Нужно получить сумму, близкую к числу (равному) 849 или больше. Это 356 - 2 шт. и 234 -1 шт.

Автор - Bob6320
Дата добавления - 08.11.2023 в 00:09
Апострофф Дата: Среда, 08.11.2023, 04:59 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 444
Репутация: 122 ±
Замечаний: 0% ±

Excel 1997
Bob6320, попробуйте-
[vba]
Код
Dim A#(), Amin#(), Smin#

Function GetCombination2(CoinsRange As Range, SumCellId As Range) As String
Dim I&
ReDim A(1 To CoinsRange.Count)
ReDim Amin(1 To CoinsRange.Count)
Smin = 1E+308
RR 1, CoinsRange, (SumCellId), 0
For I = 1 To CoinsRange.Count
    If Amin(I) Then GetCombination2 = GetCombination2 & Amin(I) & " of " & CoinsRange(I) & " "
Next I
End Function

Sub RR(N&, RN As Range, TR#, S#)
Dim C&, SS#
For C = (TR - S - 1) \ RN(N) + 1 To 0 Step -1
    SS = S + C * RN(N)
    A(N) = C
    If SS >= TR And SS < Smin Then
        Smin = SS
        Amin = A
    End If
    If N < RN.Count Then RR N + 1, RN, TR, SS
Next C
End Sub
[/vba]
работает (вроде?) с любым количеством чисел CoinsRange в пределах разумного.
 
Ответить
СообщениеBob6320, попробуйте-
[vba]
Код
Dim A#(), Amin#(), Smin#

Function GetCombination2(CoinsRange As Range, SumCellId As Range) As String
Dim I&
ReDim A(1 To CoinsRange.Count)
ReDim Amin(1 To CoinsRange.Count)
Smin = 1E+308
RR 1, CoinsRange, (SumCellId), 0
For I = 1 To CoinsRange.Count
    If Amin(I) Then GetCombination2 = GetCombination2 & Amin(I) & " of " & CoinsRange(I) & " "
Next I
End Function

Sub RR(N&, RN As Range, TR#, S#)
Dim C&, SS#
For C = (TR - S - 1) \ RN(N) + 1 To 0 Step -1
    SS = S + C * RN(N)
    A(N) = C
    If SS >= TR And SS < Smin Then
        Smin = SS
        Amin = A
    End If
    If N < RN.Count Then RR N + 1, RN, TR, SS
Next C
End Sub
[/vba]
работает (вроде?) с любым количеством чисел CoinsRange в пределах разумного.

Автор - Апострофф
Дата добавления - 08.11.2023 в 04:59
Bob6320 Дата: Среда, 08.11.2023, 12:29 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Спасибо большое за помощь, но есть уточнения и пожелания по корректировке.

Всё описал в приложенном файле. Заранее спасибо.


Сообщение отредактировал Bob6320 - Среда, 08.11.2023, 12:32
 
Ответить
СообщениеСпасибо большое за помощь, но есть уточнения и пожелания по корректировке.

Всё описал в приложенном файле. Заранее спасибо.

Автор - Bob6320
Дата добавления - 08.11.2023 в 12:29
Bob6320 Дата: Среда, 08.11.2023, 12:31 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Апострофф,

Спасибо большое за помощь, но есть уточнения и пожелания по корректировке.

Всё описал в приложенном файле. Заранее спасибо.
К сообщению приложен файл: raschet_v_1_1.xlsm (18.2 Kb)


Сообщение отредактировал Bob6320 - Среда, 08.11.2023, 13:09
 
Ответить
СообщениеАпострофф,

Спасибо большое за помощь, но есть уточнения и пожелания по корректировке.

Всё описал в приложенном файле. Заранее спасибо.

Автор - Bob6320
Дата добавления - 08.11.2023 в 12:31
Bob6320 Дата: Четверг, 09.11.2023, 10:43 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Добрый день есть у кого-нибудь идеи как скоррекировать скрипт?
 
Ответить
СообщениеДобрый день есть у кого-нибудь идеи как скоррекировать скрипт?

Автор - Bob6320
Дата добавления - 09.11.2023 в 10:43
Апострофф Дата: Четверг, 09.11.2023, 22:16 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 444
Репутация: 122 ±
Замечаний: 0% ±

Excel 1997
[vba]
Код
Function GetCombination3(CoinsRange As Range, SumCellId As Range) As String
Dim I&, TS#
Dim N&
TS = SumCellId
For I = 1 To CoinsRange.Count
    N = TS \ CoinsRange(I)
    TS = TS - CoinsRange(I) * N
    If TS > 0 Then
        If I = CoinsRange.Count Then
            N = N + 1
        ElseIf TS > CoinsRange(I + 1) Then
            N = N + 1
            TS = TS - CoinsRange(I)
        End If
    End If
    If N > 0 Then GetCombination3 = vbLf & GetCombination3 & N & " of " & CoinsRange(I) '& "  "
Next I
GetCombination3 = Mid$(GetCombination3, 2)
End Function
[/vba]
А вот разделить результат по ячейкам с помощью UDF не знаю как.
 
Ответить
Сообщение[vba]
Код
Function GetCombination3(CoinsRange As Range, SumCellId As Range) As String
Dim I&, TS#
Dim N&
TS = SumCellId
For I = 1 To CoinsRange.Count
    N = TS \ CoinsRange(I)
    TS = TS - CoinsRange(I) * N
    If TS > 0 Then
        If I = CoinsRange.Count Then
            N = N + 1
        ElseIf TS > CoinsRange(I + 1) Then
            N = N + 1
            TS = TS - CoinsRange(I)
        End If
    End If
    If N > 0 Then GetCombination3 = vbLf & GetCombination3 & N & " of " & CoinsRange(I) '& "  "
Next I
GetCombination3 = Mid$(GetCombination3, 2)
End Function
[/vba]
А вот разделить результат по ячейкам с помощью UDF не знаю как.

Автор - Апострофф
Дата добавления - 09.11.2023 в 22:16
Hugo Дата: Четверг, 09.11.2023, 23:47 | Сообщение № 7
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3251
Репутация: 707 ±
Замечаний: 0% ±

2019
Цитата Апострофф, 09.11.2023 в 22:16, в сообщении № 6 ()
разделить результат по ячейкам с помощью UDF

- собирать данные в массив, в финале GetCombination3 = массив, UDF записать сразу в соотв. количество ячеек как формулу массива.


excel@nxt.ru
webmoney: E265281470651 Z422237915069
 
Ответить
Сообщение
Цитата Апострофф, 09.11.2023 в 22:16, в сообщении № 6 ()
разделить результат по ячейкам с помощью UDF

- собирать данные в массив, в финале GetCombination3 = массив, UDF записать сразу в соотв. количество ячеек как формулу массива.

Автор - Hugo
Дата добавления - 09.11.2023 в 23:47
Bob6320 Дата: Пятница, 10.11.2023, 21:28 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Всем спасибо за помощь.
 
Ответить
СообщениеВсем спасибо за помощь.

Автор - Bob6320
Дата добавления - 10.11.2023 в 21:28
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вычислить сумму некоторого заданного числа значений (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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