You are here:

Excel/VBA EXCEL PERMUTATION COMBINATION

Advertisement


Question
I'm using this vba I found in Allexperts to generate combination of 25 numbers in pairs of 15, however the result will exceed 3000000 lines and supports excel 1048576'm trying to insert command to reach when calculating line 1048576 continue the calculation to the worksheet 2 spreadsheet and then 3 and so on, would help.


   'C(n, p) = n! / ((n-p)! * p!)
   'lPermutações a ser definido, seria o 'p' da fórmula acima
   Const lPermutações As Long = 15

   Dim r As Long

   Dim v(1 To 25)

   Sub Teste()
       Dim lElementos As Long
       Dim l As Long
      
       'Popula vetor de elementos
       For l = LBound(v) To UBound(v)
         v(l) = l
       Next l
      
       'C(n, p) = n! / ((n-p)! * p!)
       'lElementos seria o 'n' da fórmula acima
       lElementos = UBound(v) - LBound(v) + 1
      
       'Contador de linhas para uso no Excel:
       r = 0
      
       'Limpa Planilha ativa
       Cells.Delete
      
       'Inicia recursão:
       Combinação lElementos, lPermutações, 1
   End Sub

   Sub Combinação(n As Long, p As Long, k As Long, Optional s As String)
       If p > n - k + 1 Then Exit Sub
       If p = 0 Then
         'Para visualizar o resultado de uma combinação no Excel:
         r = r + 1
         Cells(r, "A").Resize(1, lPermutações) = Split(s, "|")
         'Se quiser visualizar o resultado na Janela de Verificação imediata, use:
         Debug.Print s
         Exit Sub
       End If
       'Recorre novamente:
       Combinação n, p - 1, k + 1, s & v(k) & "|"
       'Recorre novamente a partir do elemento anterior:
       Combinação n, p, k + 1, s
       DoEvents
   End Sub

Answer
I didn't un this through but see if this does it

'C(n, p) = n! / ((n-p)! * p!)
'lPermutações a ser definido, seria o 'p' da fórmula acima
Const lPermutações As Long = 15

Dim r As Long

Dim v(1 To 25)

Sub Teste()
Dim lElementos As Long
Dim shnum As Long
Dim l As Long
  
   'Popula vetor de elementos
   For l = LBound(v) To UBound(v)
     v(l) = l
   Next l
  
   'C(n, p) = n! / ((n-p)! * p!)
   'lElementos seria o 'n' da fórmula acima
   lElementos = UBound(v) - LBound(v) + 1
  
   'Contador de linhas para uso no Excel:
   r = 0
  
   'Limpa Planilha ativa
   Cells.Delete
  
   shnum = 1
   'Inicia recursão:
   Combinação shnum, lElementos, lPermutações, 1
End Sub

Sub Combinação(shnum As Long, n As Long, p As Long, k As Long, Optional s As String)
Dim numRows As Long

   numRows = Rows.Count
   
   If p > n - k + 1 Then Exit Sub
   
   If p = 0 Then
     
     'Para visualizar o resultado de uma combinação no Excel:
     r = r + 1
     If r > numRows Then
     
       shnum = shnum + 1
       r = 1
     End If
   
     Worksheets(shnum).Cells(r, "A").Resize(1, lPermutações) = Split(s, "|")
     'Se quiser visualizar o resultado na Janela de Verificação imediata, use:
     Debug.Print s
     Exit Sub
   End If
   
   'Recorre novamente:
   Combinação shnum, n, p - 1, k + 1, s & v(k) & "|"
   'Recorre novamente a partir do elemento anterior:
   Combinação shnum, n, p, k + 1, s
   DoEvents
End Sub

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Bob Phillips

Expertise

Can - VBA, Functions and formulas, PowerPivot, conditional formatting, data validation, charting

Experience

I have been using Excel for in excess of 20 yeras, and I am a 9 year Microsoft MVP

Organizations
PASS UK Developer Group SQL Soton SQL FAQ

Education/Credentials
BSc Mathematics

Awards and Honors
Microsoft MVP since 2005

©2016 About.com. All rights reserved.