Sub Combinations()
Dim i1 As Integer, i2 As Integer, N, k, Aux, Out, iComb, ptr, t
On Error Resume Next
i1 = InputBox("number of letters", 1) 'how many letters in your string
i2 = InputBox("number of capitals", 1) 'how many with capital
On Error GoTo 0
i2 = Application.Min(i1, i2) 'both numeric ? otherwise 0
If i2 = 0 Then MsgBox "no combinations": Exit Sub
t = Timer
N = i1
k = i2
For i = 1 To i1
s0 = s0 & Chr(96 + i) 'make your string
Next
Aux = Evaluate("=column(offset(a1,,,," & i2 & "))") 'start with 1,2,3,... as many as capitals
iComb = Application.Min(Rows.Count, WorksheetFunction.Combin(N, k)) 'number of combinations possible (less then the number of rows in a sheet !!!)
ReDim Out(1 To iComb, 1 To 1) 'prepare array
Do
ptr = ptr + 1 'pointer
s = s0 'initial string
For i = 1 To UBound(Aux)
s = Left(s, Aux(i) - 1) & UCase(Mid(s, Aux(i), 1)) & Mid(s, Aux(i) + 1, 99) 'replace several characters with their capital
Next
Out(ptr, 1) = s 'add in array
Aux(k) = Aux(k) + 1 'next combination
If Aux(k) > N Then 'laatste voorbij target !
For i = k - 1 To 1 Step -1 'voorgaande kolommen aflopen
If Aux(i) < N - (k - i) Then 'tot aan die kolom die nog 1 mag opgehoogd worden
Aux(i) = Aux(i) + 1 'die kolom 1 ophogen
For j = i + 1 To k 'alle volgende kolommen
Aux(j) = Aux(j - 1) + 1 'gelijk aan de vorige kolom +1
Next
Exit For 'wip uit de loop
End If
Next
End If
Loop While ptr < iComb
With Range("A1")
.EntireColumn.ClearContents
.Resize(UBound(Out)).Value = Out
.EntireColumn.AutoFit
.Offset(, 1).Value = UBound(Out)
End With
MsgBox Format(iComb, "#,###") & " combinations in " & Format(Timer - t, "0.0\s")
End Sub
Bookmarks