Вычислить сумму некоторого заданного числа значений

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

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

Вычислить сумму некоторого заданного числа значений (Макросы/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

Ответить

Апострофф

Дата: Среда, 08.11.2023, 04:59 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 451

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

Замечаний: 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

Дата: Среда, 08.11.2023, 12:29 | Сообщение № 3

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

Ранг: Прохожий

Сообщений: 5

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

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

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

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

Сообщение отредактировал Bob6320 - Среда, 08.11.2023, 12:32

Ответить

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

Дата: Четверг, 09.11.2023, 10:43 | Сообщение № 5

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

Ранг: Прохожий

Сообщений: 5

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

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

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

Ответить

Апострофф

Дата: Четверг, 09.11.2023, 22:16 | Сообщение № 6

Группа: Проверенные

Ранг: Обитатель

Сообщений: 451

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

Замечаний: 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 не знаю как.