you are talking about *Permutation*
given number : 1 2 3 4 5
total arrangement of permutation *=FACT(5)* = *120*
==============
12345 21345 31245 41235 51234
12354 21354 31254 41253 51243
12435 21435 31425 41325 51324
12453 21453 31452 41352 51342
12534 21534 31524 41523 51423
12543 21543 31542 41532 51432
13245 23145 32145 42135 52134
13254 23154 32154 42153 52143
13425 23415 32415 42315 52314
13452 23451 32451 42351 52341
13524 23514 32514 42513 52413
13542 23541 32541 42531 52431
14235 24135 34125 43125 53124
14253 24153 34152 43152 53142
14325 24315 34215 43215 53214
14352 24351 34251 43251 53241
14523 24513 34512 43512 53412
14532 24531 34521 43521 53421
15234 25134 35124 45123 54123
15243 25143 35142 45132 54132
15324 25314 35214 45213 54213
15342 25341 35241 45231 54231
15423 25413 35412 45312 54312
15432 25431 35421 45321 54321
==============
' VBA CODE:
'---------------------------------------------------------
Dim D() As String ' =Array Data Characters
Dim N As Byte ' =number of char
Dim Tulis As Range ' =range where output data to be written
Dim oRow As Long ' =Row index for Output
Dim oCol As Byte ' =COlumn index for Output
Dim MaxRow As Long ' =oRow when reaching Fact(N-1)
Sub PermutArranger_Jilid3()
'----------------------------------------------------------
' this procedure is only preparing variables & inisials, and
' calling "ArrangeAndWrite" (main procedur) for the first time
'----------------------------------------------------------
Dim k As Byte
oRow = 0: oCol = 1
N = Len(Trim(Range("B2")))
Set Tulis = Range("L5")
ReDim D(1 To N) As String
MaxRow = WorksheetFunction.Fact(N - 1)
ActiveSheet.Unprotect xpas
ClearDataArea ActiveSheet.Range("L2")
If N > 9 Then
MsgBox "max 9 digit, due to limitation on number of cells in a
sheet..", _
16, ThisWorkbook.Name
Exit Sub
End If
For k = 1 To N: D(k) = Mid(Trim(Range("B2")), k, 1): Next k
Application.Calculation = xlCalculationManual
Call ArrangeAndWrite(D, 1)
Application.Calculation = xlCalculationAutomatic
ActiveSheet.Protect xpas
End Sub
Private Sub ArrangeAndWrite(ByVal D, i As Byte)
' this is a recursive procedure
'-----------------------------
Dim txt As String, tmp As String * 1, j As Byte
*' limitation (if i = N)*
If i = N Then
For j = 1 To N: txt = txt & D(j): Next j
If oRow = MaxRow Then
oRow = 0: oCol = oCol + 1
End If
oRow = oRow + 1: Tulis(oRow, oCol) = txt
Else
For j = i To N
tmp = D(j): D(j) = D(i): D(i) = tmp
ArrangeAndWrite D, (i + 1)
Next j
End If
End Sub
'-----------------------------------
you can download my example workbook, if you like, at:
http://www.box.net/shared/22pginzj8p
kind regards,
siti Vi
On Sat, Jul 2, 2011 at 10:47 PM, Markkim <mark....@gmail.com> wrote:
> Hi
> I can think of a way to write this macro.
> What I want is to find any possible combination of numbers from given
> numbers to a given total. For example,
>
> Let's say
> Given numbers: 1, 2, 3, 4, 5
> total = 30
>
> Will it be possible to get any combination of Given numbers adding up to
> 30?
> Macro should say number of possible combinations and details of
> combindation
> I have been thinking about this macro for long time... but I can't think
> of any way..
>
> Any ideas???
> cheers!
>
>
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
