Option Explicit
Sub exa()
Dim FSO As FileSystemObject
Dim FIL As TextStream
Dim a, b
Dim i As Long, n As Long
Set FSO = New FileSystemObject
Set FIL = FSO.CreateTextFile(ThisWorkbook.Path & "\Test.txt")
a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17)
For i = LBound(a) To UBound(a)
b = createCombinations(a, i + 1, ",")
For n = LBound(b) To UBound(b)
FIL.WriteLine b(n)
Next
Next
FIL.Close
End Sub
Public Function createCombinations(Arr, NbrItems As Integer, Delim As String)
createCombinations = createSubset(Arr, NbrItems, Delim)
End Function
Public Function createSubset(Arr, NbrItems As Integer, Delim As String)
Dim Rslt
ReDim Rslt(0)
aSubset Arr, LBound(Arr), NbrItems, Delim, "", Rslt
ReDim Preserve Rslt(UBound(Rslt) - 1)
'Debug.Assert NbrElements(Rslt) = _
Application.WorksheetFunction.Combin(NbrElements(Arr), NbrItems)
createSubset = Rslt
End Function
Private Sub aSubset(Arr, CurrIdx, NbrItems, ByVal Delim As String, _
ByVal PreString As String, ByRef Rslt)
Dim i As Integer
If NbrItems = 0 Then
If PreString = "" Then Rslt(UBound(Rslt)) = PreString _
Else Rslt(UBound(Rslt)) = Left(PreString, Len(PreString) - Len(Delim))
ReDim Preserve Rslt(UBound(Rslt) + 1)
Else
For i = CurrIdx To NbrElements(Arr) - NbrItems + LBound(Arr)
aSubset Arr, i + 1, NbrItems - 1, Delim, _
PreString & Arr(i) & Delim, Rslt
Next i
End If
End Sub
Private Function NbrElements(Arr) As Integer
On Error Resume Next
NbrElements = UBound(Arr) - LBound(Arr) + 1
End Function
Mark