Комбинации списков (Microsoft Excel)
Рон знает, что он может использовать функцию COMBIN, чтобы определить количество комбинаций, которые могут быть составлены из числа цифр. Однако ему интересно, есть ли способ перечислить все комбинации.
В Excel нет встроенного способа перечисления комбинаций. Однако вы можете создать макрос, который сделает листинг за вас. Если вы хотите найти уникальные комбинации в наборе последовательных чисел, начинающихся с 1, то следующий набор макросов поможет. Все, что вам нужно сделать, это запустить функцию TestCNR, и вы получите «матрицу» ячеек, которая представляет количество 4-значных комбинаций в последовательном наборе значений от 1 до 10.
Sub TestCNR() Cnr 10, 4 End Sub
Sub Cnr(n, r) i = 1 For j = 1 To r Cells(i, j).Value = j Next Do Until Finished(n, r, i) j = FindFirstSmall(n, r, i) For k = 1 To j — 1 Cells(i + 1, k).Value = Cells(i, k).Value Next Cells(i + 1, j).Value = Cells(i, j).Value + 1 For k = j + 1 To r Cells(i + 1, k).Value = Cells(i + 1, k - 1).Value + 1 Next i = i + 1 Loop End Sub
Function Finished(n, r, i) Temp = True For j = r To 1 Step -1 If Cells(i, j).Value <> j + (n - r) Then Temp = False End If Next Finished = Temp End Function Function FindFirstSmall(n, r, i) j = r Do Until Cells(i, j).Value <> j + (n - r) j = j - 1 Loop FindFirstSmall = j End Function
Макрос перезаписывает все, что находится на вашем листе, поэтому убедитесь, что вы запускаете тест с отображаемым пустым листом. Если вы хотите изменить размер набора или количество элементов в подмножестве, просто измените значения, переданные в подпрограмме TestCNR.
Если вы хотите получить уникальные комбинации из строки символов (например, букв алфавита), вам необходимо использовать другой набор макросов. Следующее будет работать нормально; предполагается, что символы, которые вы хотите использовать в качестве «вселенной», находятся в ячейке A1, а число, которое вы хотите использовать в каждой уникальной комбинации, находится в ячейке A2.
Sub FindSets() Dim iA() As Integer Dim sUniv As String Dim iWanted As Integer Dim j As Integer Dim k As Integer sUniv = Cells(1, 1).Value iWanted = Cells(2, 1).Value ReDim iA(iWanted) For j = 1 To iWanted iA(j) = j Next j iRow = PutRow(iA, sUniv, 1) Do Until DoneYet(iA, Len(sUniv)) j = WorkHere(iA, Len(sUniv)) iA(j) = iA(j) + 1 For k = j + 1 To iWanted iA(k) = iA(k - 1) + 1 Next k iRow = PutRow(iA, sUniv, iRow) Loop End Sub
Function DoneYet(iB, n) As Boolean iMax = UBound(iB) Temp = True For j = iMax To 1 Step -1 If iB(j) <> j + (n - iMax) Then Temp = False End If Next DoneYet = Temp End Function
Function WorkHere(iB, n) As Integer iMax = UBound(iB) j = iMax Do Until iB(j) <> j + (n - iMax) j = j - 1 Loop WorkHere = j End Function
Function PutRow(iB, sUniv, i) iMax = UBound(iB) sTemp = "" For j = 1 To iMax sTemp = sTemp & Mid(sUniv, iB(j), 1) Next j Cells(i, 2).Value = sTemp PutRow = i + 1 End Function
Запустите макрос FindSets, и различные желаемые комбинации окажутся в столбце 2. Однако будьте осторожны при запуске макроса. Количество комбинаций может очень быстро стать очень большим. Например, если вы поместите 26 букв (от A до Z) в ячейку A1 и значение 5 в ячейку A2, макрос выйдет из строя. Зачем? Потому что существует 65 780 возможных комбинаций из пяти символов и только 65 536 строк для их размещения.
_Примечание: _
Если вы хотите узнать, как использовать макросы, описанные на этой странице (или на любой другой странице на сайтах ExcelTips), я подготовил специальную страницу, содержащую полезную информацию.
link: / excelribbon-ExcelTipsMacros [Щелкните здесь, чтобы открыть эту специальную страницу в новой вкладке браузера]
.
ExcelTips — ваш источник экономичного обучения Microsoft Excel.
Этот совет (6766) относится к Microsoft Excel 97, 2000, 2002 и 2003. Вы можете найти версию этого совета для ленточного интерфейса Excel (Excel 2007 и более поздних версий) здесь:
link: / excelribbon-Listing_Combinations [Комбинации листингов]
.