Предположим, у вас есть рабочий лист с тремя столбцами данных. В первом столбце последовательно расположены все буквы алфавита от A до Z.

Второй столбец содержит количество вхождений, которое соответствует букве алфавита. Третий столбец содержит количество часов, которое соответствует букве алфавита.

Что, если вы хотите как можно более равномерно распределить комбинацию букв алфавита на четыре группы на основе третьего столбца (часы)?

Например, если сумма всех часов для каждой буквы алфавита составляет 4000 часов, вы хотите придумать комбинацию, которая разделяла бы алфавит так, чтобы в каждой из четырех групп было около 1000 часов на группу.

На самом деле это хорошо известная проблема в области дискретной математики. Для обеспечения решений было разработано множество алгоритмов, и существуют определенные языки программирования (например, LISP)

которые значительно облегчают создание древовидных структур, которые могут «искать» оптимальные решения.

В этом случае, однако, лучше всего подходит простой подход, включающий использование макроса. Предположим, что у вас есть данные в столбцах от A до C. Следующий макрос проанализирует указанный диапазон и вернет комбинацию значений, которая соответствует вашим требованиям.

Function DoDist(sRaw As Range, _   iTCol As Integer, _   iBuckets As Integer, _   iWanted As Integer, _   iRetCol As Integer) As String

Dim lGTotal As Long     Dim lPerBucket As Long     Dim lCells() As Long     Dim sRet() As String     Dim lBk() As Long     Dim sBk() As String     Dim lTemp As Long     Dim sTemp As String     Dim J As Integer     Dim K As Integer     Dim L As Integer

Application.Volatile     ReDim lCells(sRaw.Rows.Count)

ReDim sRet(sRaw.Rows.Count)

ReDim lBk(iBuckets)

ReDim sBk(iBuckets)



lGTotal = 0     For J = 1 To sRaw.Rows.Count         lCells(J) = sRaw(J, iTCol)

lGTotal = lGTotal + lCells(J)

sRet(J) = sRaw(J, iRetCol)

Next J

For J = 1 To sRaw.Rows.Count - 1         For K = J + 1 To sRaw.Rows.Count             If lCells(J) < lCells(K) Then                 lTemp = lCells(J)

lCells(J) = lCells(K)

lCells(K) = lTemp                 sTemp = sRet(J)

sRet(J) = sRet(K)

sRet(K) = sTemp             End If         Next K     Next J

lPerBucket = lGTotal / iBuckets     For J = 1 To sRaw.Rows.Count         L = iBuckets         For K = iBuckets To 1 Step -1             If lBk(K) <= lBk(L) Then L = K         Next K         lBk(L) = lBk(L) + lCells(J)

sBk(L) = sBk(L) & sRet(J) & ", "

Next J

For J = 1 To iBuckets         If Right(sBk(J), 2) = ", " Then             sBk(J) = Left(sBk(J), Len(sBk(J)) - 2)

End If         sBk(J) = sBk(J) & " (" & lBk(J) & ")"

Next J

DoDist = sBk(iWanted)

End Function

Обратите внимание, что этой функции передается пять параметров. Первый — это диапазон, который вы хотите оценить, второй — смещение столбца в этом диапазоне, который должен быть суммирован, третий — количество «сегментов», которые вы хотите использовать при оценке, четвертый — это количество ведро, которое вы хотите вернуть, а пятое — смещение столбца (в указанном диапазоне), который содержит значения, которые вы хотите вернуть.

Что делает макрос — это захватывает все значения в столбце, который вы хотите просуммировать, а затем сортирует их в порядке убывания. Эти значения, от наибольшего к наименьшему, затем распределяются между сколь угодно большим количеством «корзин»

Вы указали, что там должно быть. Число всегда добавляется в корзину, содержащую наименьший итог. Строка, возвращаемая функцией, представляет собой возвращаемые значения (все, что находится в каждой ячейке столбца, заданного пятым параметром), и общую сумму корзины.

Например, если вы хотите оценить диапазон A1: C: 26, вы хотите, чтобы распределение основывалось на значениях в третьем столбце диапазона (столбец C), вы хотели, чтобы в анализе было четыре сегмента, вы хотите вернуть третье ведро, и вы хотите, чтобы функция возвращала то, что находится в столбце A диапазона, тогда вы должны использовать следующее для вызова функции:

=DoDist(A1:C26,3,4,3,1)

_Примечание: _

Если вы хотите узнать, как использовать макросы, описанные на этой странице (или на любой другой странице на сайтах ExcelTips), я подготовил специальную страницу, содержащую полезную информацию.

link: / excelribbon-ExcelTipsMacros [Щелкните здесь, чтобы открыть эту специальную страницу в новой вкладке браузера].

ExcelTips — ваш источник экономичного обучения Microsoft Excel.

Этот совет (12234) применим к Microsoft Excel 2007, 2010, 2013 и 2016.

Вы можете найти версию этого совета для старого интерфейса меню Excel здесь:

link: / excel-Determining_Combinations_to_Make_a_Total [Определение комбинаций для получения общей суммы].